home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / basic / qbscr15.zip / QBSCR.BAS < prev    next >
BASIC Source File  |  1989-09-05  |  128KB  |  3,104 lines
  1. '┌────────────────────────────────────────────────────────────────────────┐
  2. '│                                                                        │
  3. '│                           Q B S C R . B A S                            │
  4. '│                                                                        │
  5. '│       The QBSCR Screen Routines for QuickBASIC 4.0+ Programmers        │
  6. '│                              Version 1.5                               │
  7. '│                                                                        │
  8. '│                   (C) Copyright 1989 by Tony Martin                    │
  9. '│                                                                        │
  10. '├────────────────────────────────────────────────────────────────────────┤
  11. '│                                                                        │
  12. '│  This source code is copyright 1989 by Tony Martin.  You may change    │
  13. '│  it to suit your programming needs, but you may not distribute any     │
  14. '│  modified copies of the library itself.  I retain all rights to the    │
  15. '│  source code and all library modules included with the QBSCR package,  │
  16. '│  as well as to the example programs.  You may not remove this notice   │
  17. '│  from any copies of the library itself you distribute.                 │
  18. '│                                                                        │
  19. '│  This package is shareware.  If you find it useful or use it in any    │
  20. '│  software you release, you are requested to send a donation of $15.00  │
  21. '│  to:                                                                   │
  22. '│                                                                        │
  23. '│                            Tony Martin                                 │
  24. '│                       1611 Harvest Green Ct.                           │
  25. '│                          Reston, VA 22094                              │
  26. '│                                                                        │
  27. '│  All registered users receive an "official" disk set containing the    │
  28. '│  latest verison of the QBSCR routines.  For more information, see      │
  29. '│  the QBSCR documentation.                                              │
  30. '│                                                                        │
  31. '├────────────────────────────────────────────────────────────────────────┤
  32. '│                                                                        │
  33. '│  Usage Instructions:                                                   │
  34. '│                                                                        │
  35. '│  These routines are designed to be used as a supplement to the         │
  36. '│  programs you write.  They provide capabilities not included in the    │
  37. '│  QuickBASIC language.                                                  │
  38. '│                                                                        │
  39. '│  To use the routines, simply start QuickBASIC and load or begin        │
  40. '│  entering the code for your own program.  Then load the file           │
  41. '│  QBSCR.BAS.  With both programs in QuickBASIC at the same time, you    │
  42. '│  can call any of the QBSCR functions with a CALL statement.  If you    │
  43. '│  prefer not to use CALL, then you must include the DECLARE statements  │
  44. '│  for the QBSCR routines in your own program.  You can do this by       │
  45. '│  adding the line                                                       │
  46. '│                                                                        │
  47. '│                       REM $Include: 'QBSCR.INC'                        │
  48. '│                                                                        │
  49. '│  at the beginning of your program.  This file contains the necessary   │
  50. '│  DECLARE statements.                                                   │
  51. '│                                                                        │
  52. '│  When you compile your program from the environment, the QBSCR code    │
  53. '│  will be linked in automatically.                                      │
  54. '│                                                                        │
  55. '│  An alternate method would be to use the Quick Library version of the  │
  56. '│  QBSCR routines.  Make a Quick Library version of the Screen Routines  │
  57. '│  by loading this source code into QuickBASIC and selecting the "Make   │
  58. '│  Library" function from the Run menu.  Then load the library with your │
  59. '│  your program when you load it into QuickBASIC.  Do this by starting   │
  60. '│  QuickBASIC with the command                                           │
  61. '│                                                                        │
  62. '│                          QB MYPROG /L QBSCR                            │
  63. '│                                                                        │
  64. '│  For detailed information,  see the QBSCR documentation.               │
  65. '│                                                                        │
  66. '└────────────────────────────────────────────────────────────────────────┘
  67.  
  68. '──────────────────────────────────────────────────────────────────────────
  69. ' DECLARE statements for all the QBSCR routines
  70. '──────────────────────────────────────────────────────────────────────────
  71. DECLARE FUNCTION BlockSize% (l%, r%, t%, b%)
  72. DECLARE FUNCTION ColorChk ()
  73. DECLARE FUNCTION GetBackground% (row%, col%)
  74. DECLARE FUNCTION GetForeground% (row%, col%)
  75. DECLARE FUNCTION GetString$ (leftCol!, row%, strLen%, foreColor%, backColor%)
  76. DECLARE FUNCTION GetVideoSegment! ()
  77. DECLARE FUNCTION MakeMenu% (choice$(), numOfChoices%, justify$, leftColumn!, rightColumn!, row%, marker$, fg%, bg%, hfg%, hbg%, qfg%, qbg%)
  78. DECLARE FUNCTION SubMenu% (choice$(), currentMenu%, numOfChoices%, justify$, leftColumn!, rightColumn!, row%, marker$, fg%, bg%, hfg%, hbg%, qfg%, qbg%)
  79. DECLARE FUNCTION ScreenBlank$ (delay)
  80. DECLARE SUB Banner (st$, row%)
  81. DECLARE SUB BlockRestore (l%, r%, t%, b%, scrArray%(), segment!)
  82. DECLARE SUB BlockSave (l%, r%, t%, b%, scrArray%(), segment!)
  83. DECLARE SUB BuildScreen (file$, mode%)
  84. DECLARE SUB Center (st$, row%)
  85. DECLARE SUB ClrScr (mode%, fillChar$)
  86. DECLARE SUB DisplayEntry (entry$, qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, actionCode%)
  87. DECLARE SUB GetScreen (file$)
  88. DECLARE SUB PutScreen (file$)
  89. DECLARE SUB MakeWindow (topRow!, leftCol!, botRow!, rightCol!, foreColor%, backColor%, windowType%, frameType%, shadowColor%, explodeType%, label$)
  90. DECLARE SUB MultiMenu (menusArray$(), numEntries%(), menuTitles$(), justify$, marker$, shadowCode%, fg%, bg%, hfg%, hbg%, qfg%, qbg%, menuSelected%, menuEntrySelected%)
  91. DECLARE SUB OffCenter (st$, row%, leftCol%, rightCol%)
  92. DECLARE SUB QBPrint (st$, row%, col%, fore%, back%)
  93. DECLARE SUB ScrnRestore (firstLine%, lastLine%, scrArray%(), segment)
  94. DECLARE SUB ScrnSave (firstLine%, lastLine%, scrArray%(), segment)
  95. DECLARE SUB Wipe (top%, bottom%, lft%, rght%, back%)
  96.  
  97. '──────────────────────────────────────────────────────────────────────────
  98. ' CONSTants required by the Screen Routines
  99. '──────────────────────────────────────────────────────────────────────────
  100. CONST FALSE = 0, TRUE = NOT FALSE
  101. CONST LEFTARROWCODE = -99
  102. CONST RIGHTARROWCODE = -98
  103.  
  104. SUB Banner (st$, row%) STATIC
  105.  
  106. '┌────────────────────────────────────────────────────────────────────────┐
  107. '│  This subroutine displays a scrolling banner on any line of the        │
  108. '│  display screen.  The scrolling effect is achieved through successive  │
  109. '│  calls to this subfunction.  Each call shifts the string by 1 char-    │
  110. '│  acter and redisplays it.                                              │
  111. '│                                                                        │
  112. '│  Parameters are as follows:                                            │
  113. '│                                                                        │
  114. '│      st$ - The string containing the text to be scrolled.  Must be     │
  115. '│            80 characters or less.                                      │
  116. '│      row% - The row of the screen on which to scroll the text.  Valid  │
  117. '│             range is 1 through 23.                                     │
  118. '└────────────────────────────────────────────────────────────────────────┘
  119.  
  120. '──────────────────────────────────────────────────────────────────────────
  121. ' Check to see if this is the first time Banner has been called
  122. '──────────────────────────────────────────────────────────────────────────
  123. temp$ = ""
  124. IF NOT (bannerFlag) THEN
  125.     bannerFlag = -1
  126.     text$ = st$
  127. END IF
  128.  
  129. '──────────────────────────────────────────────────────────────────────────
  130. ' Move each character in the banner string one space to the left
  131. '──────────────────────────────────────────────────────────────────────────
  132. FOR n = 1 TO LEN(text$) - 1
  133.     temp$ = temp$ + MID$(text$, n + 1, 1)
  134. NEXT n
  135.  
  136. '──────────────────────────────────────────────────────────────────────────
  137. ' Set the last character in Temp$ to the first character of the string
  138. '──────────────────────────────────────────────────────────────────────────
  139. temp$ = temp$ + LEFT$(text$, 1)
  140.  
  141. '──────────────────────────────────────────────────────────────────────────
  142. ' Determine the column to display the new string on, centered
  143. '──────────────────────────────────────────────────────────────────────────
  144. text$ = temp$
  145. x% = INT((80 - (LEN(text$))) / 2) + 1
  146.  
  147. '──────────────────────────────────────────────────────────────────────────
  148. ' Print the newly adjusted string
  149. '──────────────────────────────────────────────────────────────────────────
  150. LOCATE row%, x%, 0
  151. PRINT text$;
  152.  
  153. END SUB
  154.  
  155. SUB BlockRestore (l%, r%, t%, b%, scrArray%(), segment!)
  156.  
  157.     '┌──────────────────────────────────────────────────────────────────┐
  158.     '│  This subprogram will restore a rectanglar portion of the screen │
  159.     '│  that was saved using the QBSCR routine "BlockSave."  The first  │
  160.     '│  four parameters are the left, right, top, and bottom sides of   │
  161.     '│  the rectangular area to restore.  They should be the same as    │
  162.     '│  the ones used when the area was saved.  The scrArray% is an     │
  163.     '│  integer array passed to this routine, that was originally used  │
  164.     '│  to save the screen area.  The segment parameter is the segment  │
  165.     '│  of the screen memory to restore the saved info to.  For this    │
  166.     '│  parameter, simply use the QBSCR GetVideoSegment function.       │
  167.     '└──────────────────────────────────────────────────────────────────┘
  168.    
  169.     '────────────────────────────────────────────────────────────────────
  170.     ' Determine where to start restoring in screen memory
  171.     '────────────────────────────────────────────────────────────────────
  172.     wdth% = 2 * (r% - l%) + 1
  173.     offset% = 160 * (t% - 1) + 2 * (l% - 1)
  174.     z% = 0
  175.  
  176.     '────────────────────────────────────────────────────────────────────
  177.     ' Set the memory segment to the screen memory address
  178.     '────────────────────────────────────────────────────────────────────
  179.     DEF SEG = segment
  180.  
  181.     '────────────────────────────────────────────────────────────────────
  182.     ' Restore the rectangular area of the screen by POKEing the stored
  183.     ' screen display info into the display memory
  184.     '────────────────────────────────────────────────────────────────────
  185.     FOR x% = t% TO b%
  186.         FOR y% = 0 TO wdth%
  187.             POKE offset% + y%, scrArray%(z%)
  188.             z% = z% + 1
  189.         NEXT y%
  190.         offset% = offset% + 160
  191.     NEXT x%
  192.    
  193.     '────────────────────────────────────────────────────────────────────
  194.     ' Restore BASIC's default data segment
  195.     '────────────────────────────────────────────────────────────────────
  196.     DEF SEG
  197.  
  198. END SUB
  199.  
  200. SUB BlockSave (l%, r%, t%, b%, scrArray%(), segment!)
  201.  
  202.     '┌──────────────────────────────────────────────────────────────────┐
  203.     '│  This subprogram will save a rectanglar portion of the screen    │
  204.     '│  in an integer array.  The first four parameters are the left,   │
  205.     '│  right, top, and bottom sides of the rectangular area to         │
  206.     '│  restore.  The scrArray% is an integer array passed to this      │
  207.     '│  routine in which to save the screen area. The segment parameter │
  208.     '│  is the segment of the screen memory to save from.  For this     │
  209.     '│  parameter, simply use the QBSCR GetVideoSegment function.       │
  210.     '└──────────────────────────────────────────────────────────────────┘
  211.   
  212.     '────────────────────────────────────────────────────────────────────
  213.     ' Determine where to start saving in screen memory
  214.     '────────────────────────────────────────────────────────────────────
  215.     wdth% = 2 * (r% - l%) + 1
  216.     offset% = 160 * (t% - 1) + 2 * (l% - 1)
  217.     z% = 0
  218.  
  219.     '────────────────────────────────────────────────────────────────────
  220.     ' Set the memory segment to the screen memory address
  221.     '────────────────────────────────────────────────────────────────────
  222.     DEF SEG = segment
  223.    
  224.     '────────────────────────────────────────────────────────────────────
  225.     ' Save the rectangular area of the screen by PEEKing into the
  226.     ' screen display memory at the right place
  227.     '────────────────────────────────────────────────────────────────────
  228.     FOR x% = t% TO b%
  229.         FOR y% = 0 TO wdth%
  230.             scrArray%(z%) = PEEK(offset% + y%)
  231.             z% = z% + 1
  232.         NEXT y%
  233.         offset% = offset% + 160
  234.     NEXT x%
  235.    
  236.     '────────────────────────────────────────────────────────────────────
  237.     ' Restore BASIC's default data segment
  238.     '────────────────────────────────────────────────────────────────────
  239.     DEF SEG
  240.  
  241. END SUB
  242.  
  243. FUNCTION BlockSize% (l%, r%, t%, b%)
  244.  
  245.     '┌──────────────────────────────────────────────────────────────────┐
  246.     '│  This function will calculate the number of elements required    │
  247.     '│  for an array used to save a rectangular area of the screen.     │
  248.     '│  The four parameters are the left, right, top, and bottom values │
  249.     '│  of the rectangular area of the screen.  Use the function right  │
  250.     '│  inside the DIM statement, like this:                            │
  251.     '│              DIM scrArray%(BlockSize%(1, 1, 10, 20))             │
  252.     '└──────────────────────────────────────────────────────────────────┘
  253.  
  254.     BlockSize% = ((r% - l% + 1) * (b% - t% + 1)) * 2
  255.  
  256. END FUNCTION
  257.  
  258. SUB BuildScreen (file$, mode%)
  259.  
  260. '┌────────────────────────────────────────────────────────────────────────┐
  261. '│  This routine allows you to place on the screen a predefined display   │
  262. '│  that was created with Screen Builder.  It will place the display on   │
  263. '│  the screen in any of sixteen different ways.  Note that the methods   │
  264. '│  of displaying the screen are identical to the methods used in the     │
  265. '│  ClrScr routine.  Some code differences will be apparent for obvious   │
  266. '│  reasons.                                                              │
  267. '│                                                                        │
  268. '│  Parameters are as follows:                                            │
  269. '│                                                                        │
  270. '│      file$ - The name of the screen file that was saved using the      │
  271. '│              Screen Builder program.                                   │
  272. '│      mode% - The method to use when placing the screen on the display. │
  273. '└────────────────────────────────────────────────────────────────────────┘
  274.  
  275. '──────────────────────────────────────────────────────────────────────────
  276. ' The delay local variable is used here for dummy loops that create a
  277. ' very brief pauses of execution at points in the routine that need it,
  278. ' particularly in the vertical motion.  Change this value to suit the
  279. ' speed of your machine, or make it 0 to get rid of it.
  280. '──────────────────────────────────────────────────────────────────────────
  281. delay = 10
  282. COLOR f%, b%
  283.  
  284. '──────────────────────────────────────────────────────────────────────────
  285. ' Load the screen file into an array for later access
  286. '──────────────────────────────────────────────────────────────────────────
  287. DIM scrArray(4000) AS STRING * 1
  288. DIM sArray%(4000)
  289. DEF SEG = VARSEG(scrArray(0))
  290. BLOAD file$, VARPTR(scrArray(0))
  291. DEF SEG
  292.  
  293. '──────────────────────────────────────────────────────────────────────────
  294. ' Convert the array to one that runs much faster
  295. '──────────────────────────────────────────────────────────────────────────
  296. FOR x% = 0 TO 3999
  297.     sArray%(x%) = ASC(scrArray(x%))
  298. NEXT x%
  299.  
  300. '──────────────────────────────────────────────────────────────────────────
  301. ' Determine the memory segment of the video display for all direct screen
  302. ' writes and save it in vidSeg
  303. '──────────────────────────────────────────────────────────────────────────
  304. vidSeg = GetVideoSegment
  305.  
  306. SELECT CASE mode%
  307.  
  308. CASE 0    ' ─ Horizontal build, middle out ────────────────────────────────
  309.     y% = 12
  310.     FOR x% = 13 TO 1 STEP -1
  311.         FOR d = 1 TO delay: NEXT d
  312.         y% = y% + 1
  313.         xOffSet% = (x% - 1) * 160
  314.         yOffSet% = (y% - 1) * 160
  315.         DEF SEG = vidSeg
  316.         FOR a% = 0 TO 159
  317.             POKE xOffSet% + a%, sArray%(xOffSet% + a%)
  318.             POKE yOffSet% + a%, sArray%(yOffSet% + a%)
  319.         NEXT a%
  320.         DEF SEG
  321.     NEXT x%
  322.      
  323. CASE 1    ' ─ Horizontal build, ends in ───────────────────────────────────
  324.     y% = 26
  325.     FOR x% = 1 TO 13
  326.         FOR d = 1 TO delay: NEXT d    ' Delay loop - change delay above to
  327.         y% = y% - 1                   '              regulate speed
  328.         xOffSet% = (x% - 1) * 160
  329.         yOffSet% = (y% - 1) * 160
  330.         DEF SEG = vidSeg
  331.         FOR a% = 0 TO 159
  332.             POKE xOffSet% + a%, sArray%(xOffSet% + a%)
  333.             POKE yOffSet% + a%, sArray%(yOffSet% + a%)
  334.         NEXT a%
  335.         DEF SEG
  336.     NEXT x%
  337.      
  338. CASE 2   ' ─ Vertical build, middle out ───────────────────────────────────
  339.     y% = 39
  340.     FOR x% = 39 TO 0 STEP -1
  341.         y% = y% + 1
  342.         DEF SEG = vidSeg
  343.         FOR i% = 1 TO 25
  344.             xOffSet% = ((i% - 1) * 160) + (x% * 2)
  345.             yOffSet% = ((i% - 1) * 160) + (y% * 2)
  346.             POKE xOffSet%, sArray%(xOffSet%): POKE xOffSet% + 1, sArray%(xOffSet% + 1)
  347.             POKE yOffSet%, sArray%(yOffSet%): POKE yOffSet% + 1, sArray%(yOffSet% + 1)
  348.         NEXT i%
  349.         DEF SEG
  350.         FOR d = 1 TO delay: NEXT d
  351.     NEXT x%
  352.      
  353. CASE 3   ' ─ Vertical build, ends in ──────────────────────────────────────
  354.     y% = 80
  355.     FOR x% = 0 TO 40
  356.         y% = y% - 1
  357.         DEF SEG = vidSeg
  358.         FOR i% = 1 TO 25
  359.             xOffSet% = ((i% - 1) * 160) + (x% * 2)
  360.             yOffSet% = ((i% - 1) * 160) + (y% * 2)
  361.             POKE xOffSet%, sArray%(xOffSet%): POKE xOffSet% + 1, sArray%(xOffSet% + 1)
  362.             POKE yOffSet%, sArray%(yOffSet%): POKE yOffSet% + 1, sArray%(yOffSet% + 1)
  363.         NEXT i%
  364.         DEF SEG
  365.         FOR d = 1 TO delay: NEXT d
  366.     NEXT x%
  367.  
  368. CASE 4   ' ─ Left to right screen build ───────────────────────────────────
  369.     FOR x% = 0 TO 79
  370.         DEF SEG = vidSeg
  371.         FOR i% = 1 TO 25
  372.             xOffSet% = ((i% - 1) * 160) + (x% * 2)
  373.             POKE xOffSet%, sArray%(xOffSet%): POKE xOffSet% + 1, sArray%(xOffSet% + 1)
  374.         NEXT i%
  375.         DEF SEG
  376.         FOR d = 1 TO delay: NEXT d
  377.     NEXT x%
  378.  
  379. CASE 5   ' ─ Right to left screen build ───────────────────────────────────
  380.     FOR x% = 79 TO 0 STEP -1
  381.         DEF SEG = vidSeg
  382.         FOR i% = 1 TO 25
  383.             xOffSet% = ((i% - 1) * 160) + (x% * 2)
  384.             POKE xOffSet%, sArray%(xOffSet%): POKE xOffSet% + 1, sArray%(xOffSet% + 1)
  385.         NEXT i%
  386.         DEF SEG
  387.         FOR d = 1 TO delay: NEXT d
  388.     NEXT x%
  389.  
  390. CASE 6   ' ─ All sides in to center ───────────────────────────────────────
  391.     y% = 25
  392.     FOR x% = 0 TO 13
  393.         y% = y% - 1
  394.         topOffSet% = x% * 160
  395.         botOffSet% = y% * 160
  396.         DEF SEG = vidSeg
  397.         ' Top-most row
  398.         FOR j% = (x% * 3) TO (y% * 3) + 7
  399.             POKE topOffSet% + (j% * 2), sArray%(topOffSet% + (j% * 2))
  400.             POKE topOffSet% + (j% * 2) + 1, sArray%(topOffSet% + (j% * 2) + 1)
  401.         NEXT j%
  402.         ' Left and right sides
  403.         FOR j% = x% TO y%
  404.             FOR i% = 0 TO 5
  405.                 POKE (j% * 160) + (x% * 6) + i%, sArray%((j% * 160) + (x% * 6) + i%)
  406.                 POKE (j% * 160) + (y% * 6) + 10 + i%, sArray%((j% * 160) + (y% * 6) + 10 + i%)
  407.             NEXT i%
  408.         NEXT j%
  409.  
  410.         ' Bottom-most row
  411.         FOR j% = (x% * 3) TO (y% * 3) + 7
  412.             POKE botOffSet% + (j% * 2), sArray%(botOffSet% + (j% * 2))
  413.             POKE botOffSet% + (j% * 2) + 1, sArray%(botOffSet% + (j% * 2) + 1)
  414.         NEXT j%
  415.         DEF SEG
  416.     NEXT x%
  417.  
  418. CASE 7   ' ─ All sides out from center ────────────────────────────────────
  419.     y% = 11
  420.     FOR x% = 12 TO 0 STEP -1
  421.         y% = y% + 1
  422.         topOffSet% = x% * 160
  423.         botOffSet% = y% * 160
  424.         DEF SEG = vidSeg
  425.         ' Top-most row
  426.         FOR j% = (x% * 3) TO (y% * 3) + 7
  427.             POKE topOffSet% + (j% * 2), sArray%(topOffSet% + (j% * 2))
  428.             POKE topOffSet% + (j% * 2) + 1, sArray%(topOffSet% + (j% * 2) + 1)
  429.         NEXT j%
  430.         ' Left and right sides
  431.         FOR j% = x% TO y%
  432.             FOR i% = 0 TO 5
  433.                 POKE (j% * 160) + (x% * 6) + i%, sArray%((j% * 160) + (x% * 6) + i%)
  434.                 POKE (j% * 160) + (y% * 6) + 10 + i%, sArray%((j% * 160) + (y% * 6) + 10 + i%)
  435.             NEXT i%
  436.         NEXT j%
  437.         ' Bottom-most row
  438.         FOR j% = (x% * 3) TO (y% * 3) + 7
  439.             POKE botOffSet% + (j% * 2), sArray%(botOffSet% + (j% * 2))
  440.             POKE botOffSet% + (j% * 2) + 1, sArray%(botOffSet% + (j% * 2) + 1)
  441.         NEXT j%
  442.         DEF SEG
  443.     NEXT x%
  444.  
  445. CASE 8   ' ─ Vertical split - left down, right up ─────────────────────────
  446.     y% = 26
  447.     FOR x% = 1 TO 25
  448.         FOR d = 1 TO delay: NEXT d
  449.         y% = y% - 1
  450.         DEF SEG = vidSeg
  451.         offset% = (x% - 1) * 160
  452.         FOR i% = 0 TO 79
  453.             POKE offset% + i%, sArray%(offset% + i%)
  454.         NEXT i%
  455.         offset% = (y% - 1) * 160
  456.         FOR i% = 80 TO 159
  457.             POKE offset% + i%, sArray%(offset% + i%)
  458.         NEXT i%
  459.         DEF SEG
  460.     NEXT x%
  461.  
  462. CASE 9   ' ─ Horizontal split - top right to left, bottom left to right ───
  463.     y% = 80
  464.     FOR x% = 0 TO 79
  465.         y% = y% - 1
  466.         DEF SEG = vidSeg
  467.         FOR i% = 1 TO 12
  468.             offset% = ((i% - 1) * 160) + (x% * 2)
  469.             POKE offset%, sArray%(offset%): POKE offset% + 1, sArray%(offset% + 1)
  470.         NEXT i%
  471.         FOR i% = 13 TO 25
  472.             offset% = ((i% - 1) * 160) + (y% * 2)
  473.             POKE offset%, sArray%(offset%): POKE offset% + 1, sArray%(offset% + 1)
  474.         NEXT i%
  475.         DEF SEG
  476.     NEXT x%
  477.  
  478. CASE 10  ' ─ Spiral inward ────────────────────────────────────────────────
  479.  
  480.     FOR x% = 1 TO 25                                 ' │
  481.         offset% = (x% - 1) * 160                     ' │
  482.         DEF SEG = vidSeg                             ' │
  483.         FOR y% = 0 TO 31                             ' │
  484.             POKE offset% + y%, sArray%(offset% + y%) ' 
  485.         NEXT y%
  486.         DEF SEG
  487.     NEXT x%
  488.     offset% = 19 * 160                               ' │
  489.     FOR x% = 16 TO 79                                ' │
  490.         DEF SEG = vidSeg                             ' │
  491.         FOR y% = 0 TO 5                              ' └────────────
  492.             POKE 3040 + (x% * 2) + (y% * 160), sArray%(3040 + (x% * 2) + (y% * 160))
  493.             POKE 3041 + (x% * 2) + (y% * 160), sArray%(3041 + (x% * 2) + (y% * 160))
  494.         NEXT y%
  495.         DEF SEG
  496.     NEXT x%
  497.     FOR x% = 19 TO 1 STEP -1                         ' │            
  498.         offset% = (x% - 1) * 160 + 127               ' │            │
  499.         DEF SEG = vidSeg                             ' │            │
  500.         FOR y% = 0 TO 32                             ' │            │
  501.             POKE offset% + y%, sArray%(offset% + y%) ' └────────────┘
  502.         NEXT y%
  503.         DEF SEG
  504.     NEXT x%
  505.                                                      ' │ ──────────┐
  506.     FOR x% = 63 TO 16 STEP -1                        ' │            │
  507.         DEF SEG = vidSeg                             ' │            │
  508.         FOR y% = 0 TO 5                              ' └────────────┘
  509.             POKE 1 + (x% * 2) + (y% * 160), sArray%(1 + (x% * 2) + (y% * 160))
  510.             POKE (x% * 2) + (y% * 160), sArray%((x% * 2) + (y% * 160))
  511.         NEXT y%
  512.         DEF SEG
  513.     NEXT x%
  514.     FOR x% = 7 TO 19
  515.         offset% = (x% - 1) * 160 + 32                ' │ ┌──────────┐
  516.         DEF SEG = vidSeg                             ' │ │          │
  517.         FOR y% = 0 TO 31                             ' │ │          │
  518.             POKE offset% + y%, sArray%(offset% + y%) ' │           │
  519.         NEXT y%                                      ' └────────────┘
  520.         DEF SEG
  521.     NEXT x%
  522.     offset% = 19 * 160                               ' │ ┌──────────┐
  523.     FOR x% = 32 TO 63                                ' │ │          │
  524.         DEF SEG = vidSeg                             ' │ └──────── │
  525.         FOR y% = 0 TO 5                              ' └────────────┘
  526.             POKE 2240 + (x% * 2) + (y% * 160), sArray%(2240 + (x% * 2) + (y% * 160))
  527.             POKE 2241 + (x% * 2) + (y% * 160), sArray%(2241 + (x% * 2) + (y% * 160))
  528.         NEXT y%
  529.         DEF SEG
  530.     NEXT x%
  531.     FOR x% = 14 TO 6 STEP -1                         ' │ ┌──────────┐
  532.         offset% = (x% - 1) * 160 + 95                ' │ │         │
  533.         DEF SEG = vidSeg                             ' │ │        │ │
  534.         FOR y% = 1 TO 31                             ' │ └────────┘ │
  535.             POKE offset% + y%, sArray%(offset% + y%) ' └────────────┘
  536.         NEXT y%
  537.         DEF SEG
  538.     NEXT x%
  539.     offset% = 6 * 160                                ' │ ┌──────────┐
  540.     FOR x% = 47 TO 32 STEP -1                        ' │ │ ──────┐ │
  541.         DEF SEG = vidSeg                             ' │ └────────┘ │
  542.         FOR y% = 0 TO 5                              ' └────────────┘
  543.             POKE offset% + 1 + (x% * 2) + (y% * 160), sArray%(offset% + 1 + (x% * 2) + (y% * 160))
  544.             POKE offset% + (x% * 2) + (y% * 160), sArray%(offset% + (x% * 2) + (y% * 160))
  545.         NEXT y%
  546.         DEF SEG
  547.     NEXT x%
  548.     FOR x% = 13 TO 14
  549.         offset% = (x% - 1) * 160 + 64                ' │ ┌──────────┐
  550.         DEF SEG = vidSeg                             ' │ │   ┌────┐ │
  551.         FOR y% = 0 TO 31                             ' │ │       │ │
  552.             POKE offset% + y%, sArray%(offset% + y%) ' │ └────────┘ │
  553.         NEXT y%                                      ' └────────────┘
  554.         DEF SEG
  555.     NEXT x%
  556.  
  557. CASE 11  ' ─ Top to bottom ────────────────────────────────────────────────
  558.  
  559.     FOR x% = 1 TO 25
  560.         FOR d = 1 TO delay: NEXT d
  561.         DEF SEG = vidSeg
  562.         offset% = (x% - 1) * 160
  563.         FOR i% = 0 TO 159
  564.             POKE offset% + i%, sArray%(offset% + i%)
  565.         NEXT i%
  566.         DEF SEG
  567.     NEXT x%
  568.  
  569. CASE 12  ' ─ Bottom to top ────────────────────────────────────────────────
  570.  
  571.     FOR x% = 25 TO 1 STEP -1
  572.         FOR d = 1 TO delay: NEXT d
  573.         DEF SEG = vidSeg
  574.         offset% = (x% - 1) * 160
  575.         FOR i% = 0 TO 159
  576.             POKE offset% + i%, sArray%(offset% + i%)
  577.         NEXT i%
  578.         DEF SEG
  579.     NEXT x%
  580.  
  581. CASE 13   ' ─ Upper-left corner to lower-right ────────────────────────────
  582.      
  583.     FOR x% = 1 TO 25
  584.  
  585.         ' The horizontal portion...
  586.         offset% = (x% - 1) * 160
  587.         DEF SEG = vidSeg
  588.         FOR i% = offset% TO offset% + (x% * 6)
  589.             POKE i%, sArray%(i%)
  590.         NEXT i%
  591.        
  592.         ' ...and the vertical portion.
  593.         FOR y% = 1 TO x%
  594.             offset% = ((y% - 1) * 160) + (x% * 6)
  595.             DEF SEG = vidSeg
  596.             FOR j% = 0 TO 5
  597.                 POKE offset% + j%, sArray%(offset% + j%)
  598.             NEXT j%
  599.             DEF SEG
  600.         NEXT y%
  601.     NEXT x%
  602.  
  603.     ' Take care of the remaining two columns
  604.     FOR y% = 1 TO 25
  605.         offset% = ((y% - 1) * 160) + 155
  606.         DEF SEG = vidSeg
  607.         FOR j% = 0 TO 4
  608.             POKE offset% + j%, sArray%(offset% + j%)
  609.         NEXT j%
  610.         DEF SEG
  611.     NEXT y%
  612.   
  613. CASE 14   ' ─ Lower-right corner to upper-left ────────────────────────────
  614.  
  615.     ' Take care of the last two columns
  616.     FOR y% = 1 TO 25
  617.         offset% = ((y% - 1) * 160) + 155
  618.         DEF SEG = vidSeg
  619.         FOR j% = 0 TO 4
  620.             POKE offset% + j%, sArray%(offset% + j%)
  621.         NEXT j%
  622.         DEF SEG
  623.     NEXT y%
  624.  
  625.     FOR x% = 25 TO 1 STEP -1
  626.    
  627.         ' The hori(zontal portion...
  628.         offset% = (x% - 1) * 160
  629.         DEF SEG = vidSeg
  630.         FOR i% = offset% TO offset% + (x% * 6)
  631.             POKE i%, sArray%(i%)
  632.         NEXT i%
  633.       
  634.         ' ...and the vertical portion.
  635.         FOR y% = 1 TO x%
  636.             offset% = ((y% - 1) * 160) + (x% * 6)
  637.             DEF SEG = vidSeg
  638.             FOR j% = 0 TO 5
  639.                 POKE offset% + j%, sArray%(offset% + j%)
  640.             NEXT j%
  641.             DEF SEG
  642.         NEXT y%
  643.     NEXT x%
  644.  
  645. CASE 15   ' ─ Random blocks ───────────────────────────────────────────────
  646.  
  647.     RANDOMIZE TIMER
  648.     DIM screenGrid%(1 TO 5, 1 TO 10)
  649.  
  650.     FOR x% = 1 TO 50
  651.  
  652.         ' Find a block of the screen that hasn't been displayed yet
  653.         validBlock% = FALSE
  654.         DO
  655.             row% = INT(RND(1) * 5) + 1
  656.             col% = INT(RND(1) * 10) + 1
  657.             IF screenGrid%(row%, col%) = FALSE THEN
  658.                 validBlock% = TRUE
  659.                 screenGrid%(row%, col%) = TRUE
  660.             END IF
  661.         LOOP UNTIL validBlock%
  662.        
  663.         ' Display the block
  664.         FOR i% = ((row% - 1) * 5) TO ((row% - 1) * 5) + 4
  665.             offset% = (i% * 160) + ((col% - 1) * 16)
  666.             DEF SEG = vidSeg
  667.             FOR j% = offset% TO offset% + 15
  668.                 POKE j%, sArray%(j%)
  669.             NEXT j%
  670.             DEF SEG
  671.         NEXT i%
  672.     NEXT x%
  673.   
  674. END SELECT
  675.  
  676. END SUB
  677.  
  678. SUB Center (st$, row%)
  679.  
  680. '┌────────────────────────────────────────────────────────────────────────┐
  681. '│  This subroutine will display a string passed to it centered on the    │
  682. '│  row passed to it.  Parameters are as follows:                         │
  683. '│                                                                        │
  684. '│      st$ - The string to center on the screen.  String must be 80      │
  685. '│            characters or less.                                         │
  686. '│      row% - The row of the screen on which to center the string.       │
  687. '│             Must be in the range 1 through 25.                         │
  688. '└────────────────────────────────────────────────────────────────────────┘
  689.  
  690. '──────────────────────────────────────────────────────────────────────────
  691. ' Calculate X-Coordinate (column) on which to locate the string
  692. '──────────────────────────────────────────────────────────────────────────
  693. x% = INT((80 - (LEN(st$))) / 2) + 1
  694.  
  695. '──────────────────────────────────────────────────────────────────────────
  696. ' Display the text string
  697. '──────────────────────────────────────────────────────────────────────────
  698. LOCATE row%, x%, 0: PRINT st$;
  699.  
  700. END SUB
  701.  
  702. SUB ClrScr (mode%, fillChar$)
  703.  
  704. '┌────────────────────────────────────────────────────────────────────────┐
  705. '│  This routine clears the screen in any of 10 different ways.  The      │
  706. '│  parameters are as follows:                                            │
  707. '│                                                                        │
  708. '│    mode% - A number indicating which way you want the screen cleared.  │
  709. '│            The number must be in the range of 0 through 14.  See the   │
  710. '│            QBSCR documentation or the REF program for more info.       │
  711. '│    fillChar$ - This is a single character string containing the        │
  712. '│                character you want to clear the screen with.  Under     │
  713. '│                most circumstances, this will simply be a space.        │
  714. '└────────────────────────────────────────────────────────────────────────┘
  715.  
  716. '──────────────────────────────────────────────────────────────────────────
  717. ' The Delay local variable is used here for dummy loops that create a
  718. ' very brief pauses of execution at points in the routine that need it,
  719. ' particularly in the vertical motion.  Change this value to suit the
  720. ' speed of your machine.
  721. '──────────────────────────────────────────────────────────────────────────
  722. delay = 5
  723.  
  724. '──────────────────────────────────────────────────────────────────────────
  725. ' Clear the screen.  Method used is based on the passed Mode parameter
  726. '──────────────────────────────────────────────────────────────────────────
  727. SELECT CASE mode%
  728.        
  729.     CASE 0    ' ─ Horizontal clear, middle out ────────────────────────────
  730.         y = 12
  731.         FOR x = 13 TO 1 STEP -1
  732.             FOR a = 1 TO delay: NEXT a
  733.             y = y + 1
  734.             LOCATE x, 1, 0: PRINT STRING$(80, fillChar$);
  735.             LOCATE y, 1, 0: PRINT STRING$(80, fillChar$);
  736.         NEXT x
  737.        
  738.     CASE 1    ' ─ Horizontal clear, ends in ───────────────────────────────
  739.         y = 26
  740.         FOR x = 1 TO 13
  741.             FOR a = 1 TO delay: NEXT a
  742.             y = y - 1
  743.             LOCATE x, 1, 0: PRINT STRING$(80, fillChar$);
  744.             LOCATE y, 1, 0: PRINT STRING$(80, fillChar$);
  745.         NEXT x
  746.        
  747.     CASE 2   ' ─ Vertical clear, middle out ───────────────────────────────
  748.         y% = 39
  749.         FOR x% = 39 TO 1 STEP -2
  750.             y% = y% + 2
  751.             FOR a% = 1 TO 25
  752.                 LOCATE a%, x%, 0: PRINT fillChar$ + fillChar$;
  753.                 LOCATE a%, y%, 0: PRINT fillChar$ + fillChar$;
  754.             NEXT a%
  755.         NEXT x%
  756.        
  757.     CASE 3   ' ─ Vertical clear, ends in ──────────────────────────────────
  758.         y% = 81
  759.         FOR x% = 1 TO 40 STEP 2
  760.             y% = y% - 2
  761.             FOR a% = 1 TO 25
  762.                 LOCATE a%, x%, 0: PRINT fillChar$ + fillChar$;
  763.                 LOCATE a%, y%, 0: PRINT fillChar$ + fillChar$;
  764.             NEXT a%
  765.         NEXT x%
  766.       
  767.     CASE 4   ' ─ Left to right screen wipe ────────────────────────────────
  768.         FOR x% = 1 TO 79 STEP 2
  769.             FOR a% = 1 TO 25
  770.                 LOCATE a%, x%, 0: PRINT fillChar$ + fillChar$;
  771.             NEXT a%
  772.         NEXT x%
  773.  
  774.     CASE 5   ' ─ Right to left screen wipe ────────────────────────────────
  775.         FOR x% = 79 TO 1 STEP -2
  776.             FOR a% = 1 TO 25
  777.                 LOCATE a%, x%, 0: PRINT fillChar$ + fillChar$;
  778.             NEXT a%
  779.         NEXT x%
  780.  
  781.     CASE 6   ' ─ All sides in to center ───────────────────────────────────
  782.         y% = 26
  783.         FOR x% = 1 TO 13
  784.             y% = y% - 1
  785.             LOCATE x%, 1, 0: PRINT STRING$(80, fillChar$);
  786.             LOCATE y%, 1, 0: PRINT STRING$(80, fillChar$);
  787.             FOR a1% = 1 TO 25
  788.                 LOCATE a1%, x% * 3 - 2, 0: PRINT fillChar$ + fillChar$ + fillChar$;
  789.                 LOCATE a1%, y% * 3 + 3, 0: PRINT fillChar$ + fillChar$ + fillChar$;
  790.             NEXT a1%
  791.         NEXT x%
  792.  
  793.     CASE 7   ' ─ All sides out from center ────────────────────────────────
  794.         y% = 12
  795.         FOR x% = 13 TO 1 STEP -1
  796.             y% = y% + 1
  797.             LOCATE x%, x% * 3 + 1, 0: PRINT STRING$((y% * 3 - x% * 3) + 2, fillChar$);
  798.             LOCATE y%, x% * 3 + 1, 0: PRINT STRING$((y% * 3 - x% * 3) + 2, fillChar$);
  799.             FOR a1% = x% TO y%
  800.                 LOCATE a1%, x% * 3 - 2, 0: PRINT fillChar$ + fillChar$ + fillChar$;
  801.                 LOCATE a1%, y% * 3 + 3, 0: PRINT fillChar$ + fillChar$ + fillChar$;
  802.             NEXT a1%
  803.         NEXT x%
  804.  
  805.     CASE 8   ' ─ Vertical split - left down, right up ─────────────────────
  806.         y = 26
  807.         FOR x = 1 TO 25
  808.             FOR a = 1 TO delay: NEXT a
  809.             y = y - 1
  810.             LOCATE x, 1, 0: PRINT STRING$(40, fillChar$);
  811.             LOCATE y, 41, 0: PRINT STRING$(40, fillChar$);
  812.         NEXT x
  813.  
  814.     CASE 9   ' ─ Horizontal split - top right to left, bottom left to right
  815.         y% = 81
  816.         FOR x% = 1 TO 80 STEP 2
  817.             y% = y% - 2
  818.             FOR a% = 1 TO 12
  819.                 LOCATE a%, x%, 0: PRINT fillChar$ + fillChar$;
  820.             NEXT a%
  821.             FOR a% = 13 TO 25
  822.                 LOCATE a%, y%, 0: PRINT fillChar$ + fillChar$;
  823.             NEXT a%
  824.         NEXT x%
  825.  
  826.     CASE 10  ' ─ Spiral inward ────────────────────────────────────────────
  827.         FOR x = 1 TO 25
  828.             FOR y = 1 TO delay: NEXT y
  829.             LOCATE x, 1, 0: PRINT STRING$(16, fillChar$);
  830.         NEXT x
  831.         FOR x% = 16 TO 78 STEP 3
  832.             FOR y% = 20 TO 25
  833.                 LOCATE y%, x%, 0: PRINT STRING$(5, fillChar$);
  834.             NEXT y%
  835.         NEXT x%
  836.         FOR x = 19 TO 1 STEP -1
  837.             FOR y = 1 TO delay: NEXT y
  838.             LOCATE x, 65, 0: PRINT STRING$(16, fillChar$);
  839.         NEXT x
  840.         FOR x% = 65 TO 16 STEP -3
  841.             FOR y% = 1 TO 6
  842.                 LOCATE y%, x%, 0: PRINT STRING$(5, fillChar$);
  843.             NEXT y%
  844.         NEXT x%
  845.         FOR x = 7 TO 19
  846.             FOR y = 1 TO delay: NEXT y
  847.             LOCATE x, 17, 0: PRINT STRING$(16, fillChar$);
  848.         NEXT x
  849.         FOR x% = 32 TO 64 STEP 3
  850.             FOR y% = 15 TO 19
  851.                 LOCATE y%, x%, 0: PRINT STRING$(5, fillChar$);
  852.             NEXT y%
  853.         NEXT x%
  854.         FOR x = 14 TO 6 STEP -1
  855.             FOR y = 1 TO delay: NEXT y
  856.             LOCATE x, 49, 0: PRINT STRING$(16, fillChar$);
  857.         NEXT x
  858.         FOR x% = 48 TO 33 STEP -3
  859.             FOR y% = 7 TO 10
  860.                 LOCATE y%, x%, 0: PRINT STRING$(5, fillChar$);
  861.             NEXT y%
  862.         NEXT x%
  863.         FOR x = 11 TO 14
  864.             FOR y = 1 TO delay: NEXT y
  865.             LOCATE x, 33, 0: PRINT STRING$(16, fillChar$);
  866.         NEXT x
  867.  
  868.     CASE 11  ' ─ Top to bottom ────────────────────────────────────────────
  869.  
  870.         FOR x = 1 TO 25
  871.             FOR a = 1 TO delay: NEXT a
  872.             LOCATE x, 1, 0: PRINT STRING$(80, fillChar$);
  873.         NEXT x
  874.  
  875.     CASE 12  ' ─ Bottom to top ────────────────────────────────────────────
  876.  
  877.         FOR x = 25 TO 1 STEP -1
  878.             FOR a = 1 TO delay: NEXT a
  879.             LOCATE x, 1, 0: PRINT STRING$(80, fillChar$);
  880.         NEXT x
  881.  
  882.     CASE 13  ' ─ Upper-left corner to lower-right ─────────────────────────
  883.  
  884.         fill$ = ""
  885.         FOR x% = 1 TO 25
  886.             fill$ = fill$ + STRING$(3, fillChar$)
  887.             LOCATE x%, 1, 0
  888.             PRINT fill$;
  889.             FOR y% = 1 TO x%
  890.                 LOCATE y%, x% * 3, 0
  891.                 PRINT STRING$(3, fillChar$);
  892.             NEXT y%
  893.         NEXT x%
  894.         FOR y% = 1 TO 25
  895.             LOCATE y%, 78, 0
  896.             PRINT STRING$(3, fillChar$);
  897.         NEXT y%
  898.  
  899.     CASE 14  ' ─ Lower-right corner to upper-left ─────────────────────────
  900.        
  901.         FOR y% = 1 TO 25
  902.             LOCATE y%, 78, 0
  903.             PRINT STRING$(3, fillChar$);
  904.         NEXT y%
  905.         fill$ = STRING$(80, fillChar$)
  906.         FOR x% = 25 TO 1 STEP -1
  907.             fill$ = LEFT$(fill$, LEN(fill$) - 3)
  908.             LOCATE x%, 1, 0
  909.             PRINT fill$;
  910.             FOR y% = 1 TO x%
  911.                 LOCATE y%, x% * 3, 0
  912.                 PRINT STRING$(3, fillChar$);
  913.             NEXT y%
  914.         NEXT x%
  915.  
  916.     CASE 15  ' ─ Random blocks ────────────────────────────────────────────
  917.  
  918.         RANDOMIZE TIMER
  919.         DIM screenGrid%(1 TO 5, 1 TO 10)
  920.  
  921.         ' Initialize grid tracking array to all false
  922.         FOR row% = 1 TO 5
  923.             FOR col% = 1 TO 10
  924.                 screenGrid%(row%, col%) = FALSE
  925.             NEXT col%
  926.         NEXT row%
  927.  
  928.         FOR x% = 1 TO 50
  929.  
  930.             ' Find a block of the scren that hasn't been blanked yet
  931.             validBlock% = FALSE
  932.             DO
  933.                 row% = INT(RND(1) * 5) + 1
  934.                 col% = INT(RND(1) * 10) + 1
  935.                 IF screenGrid%(row%, col%) = FALSE THEN
  936.                     validBlock% = TRUE
  937.                     screenGrid%(row%, col%) = TRUE
  938.                 END IF
  939.             LOOP UNTIL validBlock%
  940.  
  941.             ' Blank out the block
  942.             FOR i% = ((row% * 5 + 1) - 5) TO ((row% * 5 + 1) - 5) + 4
  943.                 LOCATE i%, (col% * 8 + 1) - 8, 0
  944.                 PRINT STRING$(8, fillChar$);
  945.             NEXT i%
  946.  
  947.         NEXT x%
  948.  
  949.     CASE ELSE  ' Programmer passed an invalide Mode% - do nothing
  950.  
  951. END SELECT
  952.    
  953. LOCATE 1, 1, 0
  954.  
  955. END SUB
  956.  
  957. FUNCTION ColorChk
  958.  
  959. '┌────────────────────────────────────────────────────────────────────────┐
  960. '│  This function when called checks the value stored at the machine      │
  961. '│  memory location that contains the video display type.  If the value   │
  962. '│  is hex B4 then the display is mono.  Otherwise, it is color.  The     │
  963. '│  function returns a value of False (Zero) if mono, True (Non-Zero) if  │
  964. '│  color.                                                                │
  965. '└────────────────────────────────────────────────────────────────────────┘
  966.  
  967. '──────────────────────────────────────────────────────────────────────────
  968. ' Set default segment to 0
  969. '──────────────────────────────────────────────────────────────────────────
  970. DEF SEG = 0
  971.   
  972. '──────────────────────────────────────────────────────────────────────────
  973. ' PEEK at value stored at video adapter address
  974. '──────────────────────────────────────────────────────────────────────────
  975. adapter = PEEK(&H463)
  976.  
  977. '──────────────────────────────────────────────────────────────────────────
  978. ' Set ColorChk to True or False based on value at hex &H463
  979. '──────────────────────────────────────────────────────────────────────────
  980. IF adapter = &HB4 THEN
  981.     ColorChk = 0  ' Mono (False/Zero)
  982. ELSE
  983.     ColorChk = 1  ' Color (True/Non-Zero)
  984. END IF
  985.  
  986. END FUNCTION
  987.  
  988. SUB DisplayEntry (entry$, qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, actionCode%)
  989.  
  990. '┌─────────────────────────────────────────────────────────────────────────┐
  991. '│  This routine is used only by the MakeMenu% Function.  It is not meant  │
  992. '│  for use on its own.  The routine displays the passed menu entry on the │
  993. '│  screen, and highlights the character that proceeds the marker          │
  994. '│  character.                                                             │
  995. '│                                                                         │
  996. '│  Parameters are as follows:                                             │
  997. '│                                                                         │
  998. '│      entry$ - the actual text entry to display on the screen            │
  999. '│      qfg% - Foreground color for "Quick Access" key character           │
  1000. '│      qbg% - Background color for "Quick Access" key character           │
  1001. '│      hfg% - Foreground color for entry at highlight bar                 │
  1002. '│      hbg% - Background color for entry at highlight bar                 │
  1003. '│      fg%  - Foreground color for normal entry                           │
  1004. '│      bg%  - Background color for normal entry                           │
  1005. '│      marker$ - the character used in menu entry strings that indicates  │
  1006. '│                the next character is a "Quick Access" key.              │
  1007. '│      actionCode% - Has value of 1 or 2.  1 indicates that the entry     │
  1008. '│                    being displayed is a normal, unhighlighted entry,    │
  1009. '│                    thus the "Quick Access" character in the entry will  │
  1010. '│                    be highlighted.  If 2, "Quick Access key is not      │
  1011. '│                    highlighted, since entry is in highlight bar.        │
  1012. '└─────────────────────────────────────────────────────────────────────────┘
  1013.  
  1014. '───────────────────────────────────────────────────────────────────────────
  1015. ' Assumes cursor is already at the right spot to display entry on.
  1016. ' Display each character until the marker char is found.  Print highlighted
  1017. ' "Quick Access" char if ActionCode% is 1, otherwise print normal "Quick
  1018. ' Access" char.  Then print rest of entry and return to MakeMenu%.
  1019. '───────────────────────────────────────────────────────────────────────────
  1020.  
  1021. FOR x% = 1 TO LEN(entry$)
  1022.  
  1023.     IF MID$(entry$, x%, 1) = marker$ THEN
  1024.         x% = x% + 1
  1025.         SELECT CASE actionCode%
  1026.             CASE 1
  1027.                 COLOR qfg%, qbg%
  1028.             CASE 2
  1029.                 COLOR hfg%, hbg%
  1030.             CASE ELSE
  1031.         END SELECT
  1032.     END IF
  1033.  
  1034.     PRINT MID$(entry$, x%, 1);
  1035.     IF actionCode% = 2 THEN
  1036.         COLOR hfg%, hbg%
  1037.     ELSE
  1038.         COLOR fg%, bg%
  1039.     END IF
  1040.  
  1041. NEXT x%
  1042.  
  1043. END SUB
  1044.  
  1045. FUNCTION GetBackground% (row%, col%)
  1046.  
  1047.     '┌──────────────────────────────────────────────────────────────────┐
  1048.     '│  This function will return the background color of the character │
  1049.     '│  cell at the specified row and column of the screen.             │
  1050.     '└──────────────────────────────────────────────────────────────────┘
  1051.  
  1052.     '────────────────────────────────────────────────────────────────────
  1053.     ' Set the memory segment to the address of screen memory
  1054.     '────────────────────────────────────────────────────────────────────
  1055.     DEF SEG = GetVideoSegment
  1056.  
  1057.     '────────────────────────────────────────────────────────────────────
  1058.     ' Determine the background color of the cel at row%, col%
  1059.     '────────────────────────────────────────────────────────────────────
  1060.     step1% = (PEEK(((row% - 1) * 160) + ((col% - 1) * 2) + 1) AND &HFF) \ 16
  1061.     IF step1% > 7 THEN ' Foreground is blinking
  1062.         GetBackground% = step1% - 8
  1063.     ELSE   ' Foreground is NOT blinking
  1064.         GetBackground% = step1%
  1065.     END IF
  1066.  
  1067.     '────────────────────────────────────────────────────────────────────
  1068.     ' Restore BASIC's default data segment
  1069.     '────────────────────────────────────────────────────────────────────
  1070.     DEF SEG
  1071.  
  1072. END FUNCTION
  1073.  
  1074. FUNCTION GetForeground% (row%, col%)
  1075.  
  1076.     '┌──────────────────────────────────────────────────────────────────┐
  1077.     '│  This function will return the foreground color of the character │
  1078.     '│  cell at the specified row and column of the screen.             │
  1079.     '└──────────────────────────────────────────────────────────────────┘
  1080.  
  1081.     '────────────────────────────────────────────────────────────────────
  1082.     ' Set the memory segment to the address of screen memory
  1083.     '────────────────────────────────────────────────────────────────────
  1084.     DEF SEG = GetVideoSegment
  1085.    
  1086.     '────────────────────────────────────────────────────────────────────
  1087.     ' Determine the foreground color of the cell at row%, col%
  1088.     '────────────────────────────────────────────────────────────────────
  1089.     step1% = (PEEK(((row% - 1) * 160) + ((col% - 1) * 2) + 1) AND &HFF)
  1090.     IF step1% > 127 THEN   ' Color is blinking
  1091.         GetForeground% = ((step1% - 128) MOD 16) + 16
  1092.     ELSE   ' Color is NOT blinking
  1093.         GetForeground% = step1% MOD 16
  1094.     END IF
  1095.    
  1096.     '────────────────────────────────────────────────────────────────────
  1097.     ' Restore BASIC's default data segment
  1098.     '────────────────────────────────────────────────────────────────────
  1099.     DEF SEG
  1100.  
  1101. END FUNCTION
  1102.  
  1103. SUB GetScreen (file$)
  1104.  
  1105.     '┌──────────────────────────────────────────────────────────────────┐
  1106.     '│  This subprogram will copy the contents of the display to a disk │
  1107.     '│  file specified by the file$ parameter.  The save is very fast.  │
  1108.     '└──────────────────────────────────────────────────────────────────┘
  1109.     
  1110.     '────────────────────────────────────────────────────────────────────
  1111.     ' Set the memory segment to the address of screen memory
  1112.     '────────────────────────────────────────────────────────────────────
  1113.     DEF SEG = GetVideoSegment
  1114.  
  1115.     '────────────────────────────────────────────────────────────────────
  1116.     ' Use the BASIC BSAVE statement to save the 4000 bytes of video RAM
  1117.     '────────────────────────────────────────────────────────────────────
  1118.     BSAVE file$, 0, 4000
  1119.    
  1120.     '────────────────────────────────────────────────────────────────────
  1121.     ' Restore BASIC's default data segment
  1122.     '────────────────────────────────────────────────────────────────────
  1123.     DEF SEG
  1124.  
  1125. END SUB
  1126.  
  1127. FUNCTION GetString$ (leftCol, row%, strLen%, foreColor%, backColor%)
  1128.  
  1129. '┌────────────────────────────────────────────────────────────────────────┐
  1130. '│  This function returns a user-entered string.  You can limit the       │
  1131. '│  length of the string they enter as they type, a capability not        │
  1132. '│  possible with the INPUT statement.  With minor modification of the    │
  1133. '│  SELECT CASE statements, you can also allow only certain characters    │
  1134. '│  to be entered.  Parameters are as follows:                            │
  1135. '│                                                                        │
  1136. '│      leftCol - This is the column of the screen to allow the user to   │
  1137. '│                start typing on.  Valid range is 1 through 79.          │
  1138. '│      row% - This is the row of the screen on which the user will type  │
  1139. '│             Allowable range is 1 through 25.                           │
  1140. '│      strLen% - This is a number indicating the maximum length of the   │
  1141. '│                string the user is allowed to enter.  Allowable range   │
  1142. '│                is 1 through 80.                                        │
  1143. '│      foreColor% - The foreground color to display the user's entry     │
  1144. '│                   in.  Alowable range is 0 through 15.                 │
  1145. '│      backColor% - The background color to display the user's entry     │
  1146. '│                   in.  Allowable range is 0 through 7.                 │
  1147. '└────────────────────────────────────────────────────────────────────────┘
  1148.  
  1149.  
  1150. '─────────────────────────────────────────────────────────────────────────
  1151. ' Define variables to contain keycodes
  1152. '─────────────────────────────────────────────────────────────────────────
  1153. enter$ = CHR$(13)
  1154. esc$ = CHR$(27)
  1155. backSpace$ = CHR$(8)
  1156.  
  1157. '─────────────────────────────────────────────────────────────────────────
  1158. ' Define errortone string to use with PLAY
  1159. '─────────────────────────────────────────────────────────────────────────
  1160. errorTone$ = "L60 N1 N0 N1"
  1161.  
  1162. '─────────────────────────────────────────────────────────────────────────
  1163. ' Clear variable that holds keystroke
  1164. '─────────────────────────────────────────────────────────────────────────
  1165. key$ = ""
  1166.  
  1167. '─────────────────────────────────────────────────────────────────────────
  1168. ' Set count of user-entered characters to 0
  1169. '─────────────────────────────────────────────────────────────────────────
  1170. charCount% = 0
  1171.  
  1172. '─────────────────────────────────────────────────────────────────────────
  1173. ' Set colors and locate the cursor
  1174. '─────────────────────────────────────────────────────────────────────────
  1175. COLOR foreColor%, backColor%
  1176. LOCATE row%, leftCol, 1
  1177.  
  1178. '─────────────────────────────────────────────────────────────────────────
  1179. ' Display an empty entry field and restore cursor location
  1180. '─────────────────────────────────────────────────────────────────────────
  1181. PRINT SPACE$(strLen%);
  1182. LOCATE row%, leftCol, 1
  1183.  
  1184. '─────────────────────────────────────────────────────────────────────────
  1185. ' Read keystrokes until ENTER is pressed, signalling completion.
  1186. '─────────────────────────────────────────────────────────────────────────
  1187. WHILE key$ <> enter$
  1188.  
  1189.     key$ = ""
  1190.     WHILE key$ = ""
  1191.         key$ = INKEY$
  1192.     WEND
  1193.  
  1194.     '─────────────────────────────────────────────────────────────────────
  1195.     '== Decide what to do with the returned key
  1196.     '─────────────────────────────────────────────────────────────────────
  1197.     SELECT CASE key$
  1198.  
  1199.         '─────────────────────────────────────────────────────────────────
  1200.         ' The CASE statement below is what checks for allowable characters.
  1201.         ' If you wish to change the set of allowable characters, change the
  1202.         ' conditions of the CASE statement.
  1203.         '─────────────────────────────────────────────────────────────────
  1204.  
  1205.         CASE " " TO "■"    ' ASCII 32 to 254 - allowable characters
  1206.            
  1207.             '─────────────────────────────────────────────────────────────
  1208.             ' If user has not reached the assigned maximum string length,
  1209.             ' then add the new keystroke to the entry.  Otherwise, make
  1210.             ' an error tone.
  1211.             '─────────────────────────────────────────────────────────────
  1212.             IF charCount% < strLen% THEN
  1213.                 st$ = st$ + key$
  1214.                 charCount% = charCount% + 1
  1215.                 LOCATE row%, leftCol + charCount% - 1, 1
  1216.                 PRINT key$;
  1217.                 LOCATE row%, leftCol + charCount%, 1
  1218.             ELSE
  1219.                 PLAY errorTone$
  1220.             END IF
  1221.  
  1222.         CASE backSpace$
  1223.  
  1224.             '─────────────────────────────────────────────────────────────
  1225.             ' Allow corrections via the backspace key as long as the user
  1226.             ' has not backspaced to the beginning of the line.  If they
  1227.             ' have, then play the error tone.
  1228.             '─────────────────────────────────────────────────────────────
  1229.             IF charCount% > 0 THEN
  1230.                 st$ = LEFT$(st$, LEN(st$) - 1)
  1231.                 LOCATE row%, leftCol + charCount% - 1, 1
  1232.                 PRINT " ";
  1233.                 charCount% = charCount% - 1
  1234.                 LOCATE row%, leftCol + charCount%, 1
  1235.             ELSE
  1236.                 PLAY errorTone$
  1237.             END IF
  1238.  
  1239.         CASE enter$
  1240.  
  1241.             '─────────────────────────────────────────────────────────────
  1242.             ' Finished entering string - assign string to function
  1243.             '─────────────────────────────────────────────────────────────
  1244.             GetString$ = st$
  1245.  
  1246.         CASE esc$
  1247.  
  1248.             '─────────────────────────────────────────────────────────────
  1249.             ' User hit ESCape - abort entry - exit function
  1250.             '─────────────────────────────────────────────────────────────
  1251.             GetString$ = esc$
  1252.             EXIT FUNCTION
  1253.  
  1254.         CASE ELSE
  1255.  
  1256.             '─────────────────────────────────────────────────────────────
  1257.             ' Unacceptable key was hit
  1258.             '─────────────────────────────────────────────────────────────
  1259.             PLAY errorTone$
  1260.  
  1261.     END SELECT     ' CASE Key$
  1262.  
  1263. WEND    ' WHILE Key$ <> Enter$
  1264.  
  1265. END FUNCTION
  1266.  
  1267. FUNCTION GetVideoSegment
  1268.  
  1269. '┌──────────────────────────────────────────────────────────────────────────┐
  1270. '│  This function returns as a value the memory address where the video     │
  1271. '│  display memory begins.  There are only two possible return values, one  │
  1272. '│  for monochrome and one for color.  This routine is used to obtain the   │
  1273. '│  video segment for use with the QBSCR routines ScrnSave and ScrnRestore. │
  1274. '│  Call this routine, obtain the segment, and then pass it to the two      │
  1275. '│  above listed routines.                                                  │
  1276. '└──────────────────────────────────────────────────────────────────────────┘
  1277.  
  1278. '──────────────────────────────────────────────────────────────────────────
  1279. ' Set default segment to 0.
  1280. '──────────────────────────────────────────────────────────────────────────
  1281. DEF SEG = 0
  1282.  
  1283. '──────────────────────────────────────────────────────────────────────────
  1284. ' PEEK at value stored at video adapter address.
  1285. '──────────────────────────────────────────────────────────────────────────
  1286. adapter = PEEK(&H463)
  1287.  
  1288. '──────────────────────────────────────────────────────────────────────────
  1289. ' Set function equal to proper segment value.
  1290. '──────────────────────────────────────────────────────────────────────────
  1291. IF adapter = &HB4 THEN
  1292.     GetVideoSegment = &HB000  ' Mono
  1293. ELSE
  1294.     GetVideoSegment = &HB800  ' Color
  1295. END IF
  1296.  
  1297. END FUNCTION
  1298.  
  1299. FUNCTION MakeMenu% (choice$(), numOfChoices%, justify$, leftColumn, rightColumn, row%, marker$, fg%, bg%, hfg%, hbg%, qfg%, qbg%)
  1300.  
  1301. '┌────────────────────────────────────────────────────────────────────────┐
  1302. '│  The MakeMenu function displays a menu list on the screen and allows   │
  1303. '│  the user to move a scrolling selection bar to highlight the entry of  │
  1304. '│  their choice.  Selection is made by hitting the ENTER key.  Other     │
  1305. '│  allowable keys include Home or PgUp to move to the first menu entry,  │
  1306. '│  and End or PgDn to move to the last entry.  Scroll bar wraps from top │
  1307. '│  to bottom and bottom to top.  The function returns as a value the     │
  1308. '│  position of the entry in the list of the user's selection.  For ex-   │
  1309. '│  ample, if the user selected the third item in a list of eight, the    │
  1310. '│  function would return a value of three.  Parameters for this function │
  1311. '│  are:                                                                  │
  1312. '│                                                                        │
  1313. '│  choice$() - An array of strings that contains the actual menu         │
  1314. '│              entries.  Example: Choice$(1) = "Menu selcection 1".      │
  1315. '│              Strings must be 78 characters or less in length.          │
  1316. '│  numOfChoices% - The number of menu choices available.  The same as    │
  1317. '│                  the number of elements in Choices$().  Allowable      │
  1318. '│                  range is 1 through 25.                                │
  1319. '│  justify$ - This string will contain a single letter, either an L, C,  │
  1320. '│             or a R.  L means left-justify the menu entries.  C means   │
  1321. '│             center them with respect to the left and right sides of    │
  1322. '│             the menu (see LeftColumn and RightColumn parameters below) │
  1323. '│             and an R means right-justify the menu entries.             │
  1324. '│  leftColumn - A numerical value containing the left-most column on     │
  1325. '│               which menu entries will be displayed.  Allowable range   │
  1326. '│               is 1 though 76.                                          │
  1327. '│  rightColumn - A numerical value containing the right-most column on   │
  1328. '│                which menu entries will be displayed.  Allowable range  │
  1329. '│                is 5 through 80.                                        │
  1330. '│  row% - A numerical value containing the first row on which to display │
  1331. '│         menu entries.  Allowable range is 1 through 24.                │
  1332. '│  marker$ - The character used in the menu entry strings that indicates │
  1333. '│            the next character is a "Quick Access" key.
  1334. '│  fg% - The foreground color of normal menu entries.  Allowable range   │
  1335. '│        is 0 to 15.                                                     │
  1336. '│  bg% - The background color of normal menu entries.  Allowable range   │
  1337. '│        is 0 to 7.                                                      │
  1338. '│  hfg% - The foreground color of the highlighted menu entry.  Allowable │
  1339. '│         range is 0 to 15.                                              │
  1340. '│  hbg% - The background color of the highlighted menu entry.  Allowable │
  1341. '│         range is 0 to 7.                                               │
  1342. '│  qfg% - The foreground color of the Quick Access keys.  Allowable      │
  1343. '│         range is 0 to 15.                                              │
  1344. '│  qbg% - The background color of the Quick Access keys.  Allowable      │
  1345. '│         range is 0 to 7.                                               │
  1346. '└────────────────────────────────────────────────────────────────────────┘
  1347.  
  1348. '─────────────────────────────────────────────────────────────────────────
  1349. ' Set local variables - extended scan codes for keypad keys
  1350. '─────────────────────────────────────────────────────────────────────────
  1351. up$ = CHR$(0) + CHR$(72)
  1352. down$ = CHR$(0) + CHR$(80)
  1353. enter$ = CHR$(13)
  1354. home$ = CHR$(0) + CHR$(71)
  1355. end$ = CHR$(0) + CHR$(79)
  1356. pgUp$ = CHR$(0) + CHR$(73)
  1357. pgDn$ = CHR$(0) + CHR$(81)
  1358. esc$ = CHR$(27)
  1359.  
  1360. '─────────────────────────────────────────────────────────────────────────
  1361. ' Define the error tone string to use with PLAY
  1362. '─────────────────────────────────────────────────────────────────────────
  1363. errorTone$ = "MB T120 L50 O3 AF"
  1364.  
  1365. '─────────────────────────────────────────────────────────────────────────
  1366. ' Set type of justification to uppercase
  1367. '─────────────────────────────────────────────────────────────────────────
  1368. justify$ = UCASE$(justify$)
  1369. wdth% = (rightColumn - leftColumn - 1)
  1370.  
  1371. '─────────────────────────────────────────────────────────────────────────
  1372. ' Check for out-of-bounds parameters.  If any are out of range,
  1373. ' quit the function
  1374. '─────────────────────────────────────────────────────────────────────────
  1375. IF numOfChoices% < 2 OR numOfChoices% > 25 THEN EXIT FUNCTION
  1376. IF justify$ <> "C" AND justify$ <> "L" AND justify$ <> "R" THEN EXIT FUNCTION
  1377. IF leftColumn < 1 OR rightColumn > 80 THEN EXIT FUNCTION
  1378. IF row% < 1 OR row% > 24 THEN EXIT FUNCTION
  1379.  
  1380. '─────────────────────────────────────────────────────────────────────────
  1381. ' Calculate the array of character identifiers
  1382. '─────────────────────────────────────────────────────────────────────────
  1383. REDIM charID(numOfChoices%) AS STRING * 1
  1384. FOR x% = 1 TO numOfChoices%
  1385.     FOR y% = 1 TO LEN(choice$(x%))
  1386.         IF MID$(choice$(x%), y%, 1) = marker$ THEN
  1387.             charID(x%) = UCASE$(MID$(choice$(x%), y% + 1, 1))
  1388.             EXIT FOR
  1389.         END IF
  1390.     NEXT y%
  1391. NEXT x%
  1392.  
  1393. '─────────────────────────────────────────────────────────────────────────
  1394. ' Calculate length of longest menu choice and store value in ChoiceLen%
  1395. '─────────────────────────────────────────────────────────────────────────
  1396. choiceLen% = 0
  1397. FOR x% = 1 TO numOfChoices%
  1398.     IF LEN(choice$(x%)) > choiceLen% THEN
  1399.         choiceLen% = LEN(choice$(x%))
  1400.     END IF
  1401. NEXT x%
  1402. choiceLen% = choiceLen% - 1
  1403.  
  1404. '─────────────────────────────────────────────────────────────────────────
  1405. ' Determine left-most column to display highlight bar on
  1406. '─────────────────────────────────────────────────────────────────────────
  1407. col = (((rightColumn - leftColumn - 1) - choiceLen%) / 2) + leftColumn
  1408.  
  1409. '─────────────────────────────────────────────────────────────────────────
  1410. ' Print menu choices to screen based on the type of Justification
  1411. ' selected (Center, Left, Right).
  1412. '─────────────────────────────────────────────────────────────────────────
  1413. COLOR fg%, bg%
  1414. SELECT CASE justify$
  1415.     CASE "C"
  1416.         FOR x% = 1 TO numOfChoices%
  1417.             xCol% = ((wdth% - (LEN(choice$(x%))) - 1) \ 2 + leftColumn) + 1
  1418.             LOCATE (row% - 1) + x%, leftColumn - 1, 0
  1419.             PRINT SPACE$(choiceLen% + 2);
  1420.             LOCATE (row% - 1) + x%, xCol%, 0
  1421.             DisplayEntry choice$(x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
  1422.         NEXT x%
  1423.     CASE "R"
  1424.         FOR x% = 1 TO numOfChoices%
  1425.             LOCATE (row% - 1) + x%, leftColumn - 1, 0
  1426.             PRINT SPACE$(choiceLen% + 2);
  1427.             LOCATE (row% - 1) + x%, (rightColumn - LEN(choice$(x%)))
  1428.             DisplayEntry choice$(x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
  1429.         NEXT x%
  1430.     CASE "L"
  1431.         FOR x% = 1 TO numOfChoices%
  1432.             LOCATE (row% - 1) + x%, leftColumn - 1, 0
  1433.             PRINT SPACE$(choiceLen% + 2);
  1434.             LOCATE (row% - 1) + x%, leftColumn, 0
  1435.             DisplayEntry choice$(x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
  1436.         NEXT x%
  1437. END SELECT
  1438.  
  1439. '─────────────────────────────────────────────────────────────────────────
  1440. ' Highlight the first entry in the list.  Must take into account the
  1441. ' justification type.
  1442. '─────────────────────────────────────────────────────────────────────────
  1443. currentLocation% = 1
  1444. COLOR hfg%, hbg%
  1445. LOCATE row%, leftColumn - 1: PRINT SPACE$(choiceLen% + 2);
  1446. SELECT CASE justify$
  1447.     CASE "C"
  1448.         xCol% = ((wdth% - (LEN(choice$(currentLocation%))) - 1) \ 2 + leftColumn) + 1
  1449.         LOCATE (row% - 1 + currentLocation%), xCol%, 0
  1450.         DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
  1451.     CASE "R"
  1452.         LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentLocation%)))
  1453.         DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
  1454.     CASE "L"
  1455.         LOCATE (row% - 1) + currentLocation%, leftColumn
  1456.         DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
  1457. END SELECT
  1458.  
  1459. '─────────────────────────────────────────────────────────────────────────
  1460. ' Read keystrokes and change the highlighted entry appropriately
  1461. '─────────────────────────────────────────────────────────────────────────
  1462. exitCode = FALSE
  1463. WHILE exitCode = FALSE
  1464.  
  1465.     '─────────────────────────────────────────────────────────────────────
  1466.     ' Read keystrokes
  1467.     '─────────────────────────────────────────────────────────────────────
  1468.     key$ = ""
  1469.     WHILE key$ = ""
  1470.         LET key$ = UCASE$(INKEY$)
  1471.     WEND
  1472.    
  1473.     SELECT CASE key$
  1474.  
  1475.         CASE up$, down$, home$, end$, pgUp$, pgDn$   '=== Legal movement
  1476.  
  1477.             '─────────────────────────────────────────────────────────────
  1478.             ' Restore old highlighted choice to normal colors
  1479.             '─────────────────────────────────────────────────────────────
  1480.             COLOR fg%, bg%
  1481.             LOCATE (row% - 1) + currentLocation%, leftColumn - 1: PRINT SPACE$(choiceLen% + 2);
  1482.             SELECT CASE justify$
  1483.                 CASE "C"
  1484.                     xCol% = ((wdth% - (LEN(choice$(currentLocation%))) - 1) \ 2 + leftColumn) + 1
  1485.                     LOCATE (row% - 1 + currentLocation%), xCol%, 0
  1486.                     DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
  1487.                 CASE "R"
  1488.                     LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentLocation%)))
  1489.                     DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
  1490.                 CASE "L"
  1491.                     LOCATE (row% - 1) + currentLocation%, leftColumn, 0
  1492.                     DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
  1493.             END SELECT
  1494.  
  1495.         CASE CHR$(32) TO CHR$(127)  'If valid KEY code, then restore old entry
  1496.  
  1497.             FOR x% = 1 TO numOfChoices%
  1498.                 IF key$ = charID(x%) THEN
  1499.                     COLOR fg%, bg%
  1500.                     LOCATE (row% - 1) + currentLocation%, leftColumn - 1: PRINT SPACE$(choiceLen% + 2);
  1501.                     SELECT CASE justify$
  1502.                         CASE "C"
  1503.                             xCol% = ((wdth% - (LEN(choice$(currentLocation%))) - 1) \ 2 + leftColumn) + 1
  1504.                             LOCATE (row% - 1 + currentLocation%), xCol%, 0
  1505.                             DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
  1506.                             EXIT FOR
  1507.                         CASE "R"
  1508.                             LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentLocation%)))
  1509.                             DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
  1510.                             EXIT FOR
  1511.                         CASE "L"
  1512.                             LOCATE (row% - 1) + currentLocation%, leftColumn, 0
  1513.                             DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
  1514.                             EXIT FOR
  1515.                     END SELECT
  1516.                 END IF
  1517.             NEXT x%
  1518.        
  1519.         CASE ELSE
  1520.  
  1521.             'Nuthin!
  1522.  
  1523.     END SELECT
  1524.   
  1525.     '─────────────────────────────────────────────────────────────────────
  1526.     ' Update our highlight bar's location based on which key was hit
  1527.     '─────────────────────────────────────────────────────────────────────
  1528.     SELECT CASE key$
  1529.  
  1530.         CASE up$
  1531.  
  1532.             '─────────────────────────────────────────────────────────────
  1533.             ' Set new currentLocation%
  1534.             '─────────────────────────────────────────────────────────────
  1535.             IF currentLocation% = 1 THEN
  1536.                 currentLocation% = numOfChoices%
  1537.             ELSE
  1538.                 currentLocation% = currentLocation% - 1
  1539.             END IF
  1540.            
  1541.         CASE down$
  1542.  
  1543.             '─────────────────────────────────────────────────────────────
  1544.             ' Set New currentLocation%
  1545.             '─────────────────────────────────────────────────────────────
  1546.             IF currentLocation% = numOfChoices% THEN
  1547.                 currentLocation% = 1
  1548.             ELSE
  1549.                 currentLocation% = currentLocation% + 1
  1550.             END IF
  1551.  
  1552.         CASE enter$
  1553.  
  1554.             '─────────────────────────────────────────────────────────────
  1555.             ' Set MakeMenu to highlighted selection and exit
  1556.             '─────────────────────────────────────────────────────────────
  1557.             MakeMenu% = currentLocation%
  1558.  
  1559.             '─────────────────────────────────────────────────────────────
  1560.             ' Instead of using exitCode to beak out of this, we have to
  1561.             ' use EXIT FUNCTION, or it never quits.
  1562.             '─────────────────────────────────────────────────────────────
  1563.             EXIT FUNCTION
  1564.        
  1565.         CASE home$, pgUp$
  1566.  
  1567.             '─────────────────────────────────────────────────────────────
  1568.             ' Set New currentLocation%
  1569.             '─────────────────────────────────────────────────────────────
  1570.             currentLocation% = 1
  1571.  
  1572.         CASE end$, pgDn$
  1573.  
  1574.             '─────────────────────────────────────────────────────────────
  1575.             ' Set New currentLocation%
  1576.             '─────────────────────────────────────────────────────────────
  1577.             currentLocation% = numOfChoices%
  1578.  
  1579.         CASE esc$
  1580.  
  1581.             '─────────────────────────────────────────────────────────────
  1582.             ' User hit ESCAPE key, so set MakeMenu to 0 nd exit
  1583.             '─────────────────────────────────────────────────────────────
  1584.             MakeMenu% = 0
  1585.             EXIT FUNCTION
  1586.  
  1587.         CASE CHR$(32) TO CHR$(127)
  1588.  
  1589.             '─────────────────────────────────────────────────────────────
  1590.             ' Check for "Quick Access" codes
  1591.             '─────────────────────────────────────────────────────────────
  1592.             validEntry% = FALSE
  1593.             FOR x% = 1 TO numOfChoices%
  1594.                 IF key$ = charID(x%) THEN
  1595.                     MakeMenu% = x%
  1596.                     currentLocation% = x%
  1597.                     validEntry% = TRUE
  1598.                 END IF
  1599.             NEXT x%
  1600.  
  1601.             IF validEntry% = FALSE THEN
  1602.                 PLAY errorTone$
  1603.             END IF
  1604.  
  1605.         CASE ELSE
  1606.  
  1607.             '─────────────────────────────────────────────────────────────
  1608.             ' Play Error Tone - change this around if your don't like it
  1609.             '─────────────────────────────────────────────────────────────
  1610.             PLAY errorTone$
  1611.  
  1612.     END SELECT
  1613.   
  1614.     '─────────────────────────────────────────────────────────────────────
  1615.     ' Highlight the entry indicated by CurrentLocation%
  1616.     '─────────────────────────────────────────────────────────────────────
  1617.     SELECT CASE key$
  1618.        
  1619.         CASE up$, down$, home$, end$, pgUp$, pgDn$
  1620.  
  1621.             '─────────────────────────────────────────────────────────────
  1622.             ' Highlight new choice
  1623.             '─────────────────────────────────────────────────────────────
  1624.             COLOR hfg%, hbg%
  1625.             LOCATE (row% - 1) + currentLocation%, leftColumn - 1: PRINT SPACE$(choiceLen% + 2);
  1626.             SELECT CASE justify$
  1627.                 CASE "C"
  1628.                     xCol% = ((wdth% - (LEN(choice$(currentLocation%))) - 1) \ 2 + leftColumn) + 1
  1629.                     LOCATE (row% - 1 + currentLocation%), xCol%, 0
  1630.                     DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
  1631.                 CASE "R"
  1632.                     LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentLocation%)))
  1633.                     DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
  1634.                 CASE "L"
  1635.                     LOCATE (row% - 1) + currentLocation%, leftColumn, 0
  1636.                     DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
  1637.             END SELECT
  1638.  
  1639.         CASE CHR$(32) TO CHR$(127)
  1640.  
  1641.             FOR x% = 1 TO numOfChoices%
  1642.                 IF key$ = charID(x%) THEN
  1643.  
  1644.                     '─────────────────────────────────────────────────────
  1645.                     ' Highlight new choice
  1646.                     '─────────────────────────────────────────────────────
  1647.                     COLOR hfg%, hbg%
  1648.                     LOCATE (row% - 1) + currentLocation%, leftColumn - 1: PRINT SPACE$(choiceLen% + 2);
  1649.                     SELECT CASE justify$
  1650.                         CASE "C"
  1651.                             xCol% = ((wdth% - (LEN(choice$(currentLocation%))) - 1) \ 2 + leftColumn) + 1
  1652.                             LOCATE (row% - 1 + currentLocation%), xCol%, 0
  1653.                             DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
  1654.                             EXIT FUNCTION
  1655.                         CASE "R"
  1656.                             LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentLocation%)))
  1657.                             DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
  1658.                             EXIT FUNCTION
  1659.                         CASE "L"
  1660.                             LOCATE (row% - 1) + currentLocation%, leftColumn, 0
  1661.                             DisplayEntry choice$(currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
  1662.                             EXIT FUNCTION
  1663.                     END SELECT
  1664.                 END IF
  1665.             NEXT x%
  1666.        
  1667.         CASE ELSE
  1668.  
  1669.             'Nuthin!
  1670.  
  1671.     END SELECT
  1672.  
  1673. WEND
  1674.  
  1675. END FUNCTION
  1676.  
  1677. SUB MakeWindow (topRow!, leftCol!, botRow!, rightCol!, foreColor%, backColor%, windowType%, frameType%, shadowColor%, explodeType%, label$)
  1678.  
  1679. '┌────────────────────────────────────────────────────────────────────────┐
  1680. '│  The MakeWindow subroutine draws windows on the screen for you.  The   │
  1681. '│  kinds of windows you can make is quite varied.  There are 10          │
  1682. '│  window types, six different frame types, windows can have shadows     │
  1683. '│  or not, you can "explode" them onto the screen, and even place labels │
  1684. '│  on them.  The parameters for MakeWindow are as follows:               │
  1685. '│                                                                        │
  1686. '│  topRow! - This is a numerical value containing the top-most row of    │
  1687. '│            the window.  Allowable range is 1 through 22.               │
  1688. '│  leftCol! - This is a numerical value containing the left-most side    │
  1689. '│             of the window.  Allowable range is 1 to 79.                │
  1690. '│  botRow! - This is a numerical value containing the bottom-most row    │
  1691. '│            of the window.  Allowable range is 2 through 23.            │
  1692. '│  rightCol! - This is a numerical value containing the right-most row   │
  1693. '│              of the window.  Allowable range is 2 through 80.          │
  1694. '│  foreColor% - This is the foreground color of the window.  Allowable   │
  1695. '│               range is 0 through 15.                                   │
  1696. '│  backColor% - This is the background color of the window.  Allowable   │
  1697. '│               range is 0 through 7.                                    │
  1698. '│  windowType% - This is a numerical value containing the type of window │
  1699. '│                desired.  Allowable range is 0 through 9.  See the      │
  1700. '│                QBSCR documentation for more info.                      │
  1701. '│  frameType% - This is a numerical value containing the type of frame   │
  1702. '│               you want your window to have.  Allowable range is 0      │
  1703. '│               through 5.  See the QBSCR documentation for more info.   │
  1704. '│  shadowColor% - This is a numerical value containing the color of the  │
  1705. '│                 shadow for your window.  If you desire no shadow at    │
  1706. '│                 all, use a value of -1.  Allowable range is -1 through │
  1707. '│                 15.  See the QBSCR documentation for more detail.      │
  1708. '│  explodeType% - This is a numerical value that indicates how you want  │
  1709. '│                 your window to be placed on the screen.  A value of 0  │
  1710. '│                 display it normally, top to bottom.  A value of 1      │
  1711. '│                 means explode it onto the screen using auto mode.  A   │
  1712. '│                 value of 2 means explode it onto the screen using the  │
  1713. '│                 horizontal bias mode, and a value of 3 means explode   │
  1714. '│                 it onto the screen using the vertical bias mode.  See  │
  1715. '│                 the QBSCR documentation for more details.              │
  1716. '│  label$ - This is a string used to label your window.  It is placed    │
  1717. '│           along the top line of your window, framed by brackets.       │
  1718. '│           A string of zero length ("") means don't display any label.  │
  1719. '│           Allowable string length is equal to (RightCol - LeftCol) - 4 │
  1720. '└────────────────────────────────────────────────────────────────────────┘
  1721.  
  1722. '─────────────────────────────────────────────────────────────────────────
  1723. ' Setup line$ as a dynamic array that can REDimensioned.  Line$()
  1724. ' will contain the actual character strings that make up our window.
  1725. '─────────────────────────────────────────────────────────────────────────
  1726. '$DYNAMIC
  1727. DIM line$(24)
  1728.  
  1729. '─────────────────────────────────────────────────────────────────────────
  1730. ' Initialize local variables
  1731. '─────────────────────────────────────────────────────────────────────────
  1732. part1 = 0: part2 = 0: numLines = 0
  1733.  
  1734. '─────────────────────────────────────────────────────────────────────────
  1735. ' Check all passed values for validity and set defaults
  1736. '─────────────────────────────────────────────────────────────────────────
  1737. numLines = 0
  1738.  
  1739. IF topRow < 1 THEN topRow = 1: IF topRow > 22 THEN topRow = 22
  1740. IF botRow < 2 THEN botRow = 2: IF botRow > 25 THEN botRow = 25
  1741. IF rightCol < 2 THEN rightCol = 2: IF rightCol > 80 THEN rightCol = 80
  1742. IF leftCol < 1 THEN leftCol = 1: IF leftCol > 79 THEN leftCol = 79
  1743.  
  1744. IF foreColor% < 0 OR foreColor% > 15 THEN foreColor% = 7
  1745. IF backColor% < 0 OR backColor% > 7 THEN backColor% = 0
  1746.  
  1747. IF windowType% < 0 OR windowType% > 9 THEN windowType% = 0
  1748. IF frameType% < 0 OR frameType% > 5 THEN frameType% = 0
  1749. IF shadowColor% > 16 THEN shadowColor% = -1
  1750. IF explodeType% < 0 OR explodeType% > 3 THEN explodeType% = 0
  1751.  
  1752. IF LEN(label$) > ((rightCol - leftCol) - 4) THEN label$ = ""
  1753.  
  1754. '─────────────────────────────────────────────────────────────────────────
  1755. ' Setup graphics characters to use based on FrameType%
  1756. '─────────────────────────────────────────────────────────────────────────
  1757. SELECT CASE frameType%
  1758.  
  1759.     CASE 0  ' All lines SINGLE
  1760.  
  1761.         urc$ = CHR$(191): ulc$ = CHR$(218): llc$ = CHR$(192): lrc$ = CHR$(217)
  1762.         ver$ = CHR$(179): hor$ = CHR$(196)
  1763.         vtl$ = CHR$(195): vtr$ = CHR$(180)
  1764.         htt$ = CHR$(194): htb$ = CHR$(193)
  1765.         crs$ = CHR$(197): blk$ = CHR$(219)
  1766.         lbl$ = CHR$(180): lbr$ = CHR$(195)
  1767.  
  1768.     CASE 1  ' All lines DOUBLE
  1769.  
  1770.         urc$ = CHR$(187): ulc$ = CHR$(201): llc$ = CHR$(200): lrc$ = CHR$(188)
  1771.         ver$ = CHR$(186): hor$ = CHR$(205)
  1772.         vtl$ = CHR$(204): vtr$ = CHR$(185)
  1773.         htt$ = CHR$(203): htb$ = CHR$(202)
  1774.         crs$ = CHR$(206): blk$ = CHR$(219)
  1775.         lbl$ = CHR$(181): lbr$ = CHR$(198)
  1776.  
  1777.     CASE 2  ' Horizontals SINGLE / Verticals DOUBLE
  1778.  
  1779.         urc$ = CHR$(183): ulc$ = CHR$(214): llc$ = CHR$(211): lrc$ = CHR$(189)
  1780.         ver$ = CHR$(186): hor$ = CHR$(196)
  1781.         vtl$ = CHR$(199): vtr$ = CHR$(182)
  1782.         htt$ = CHR$(210): htb$ = CHR$(208)
  1783.         crs$ = CHR$(215): blk$ = CHR$(219)
  1784.         lbl$ = CHR$(180): lbr$ = CHR$(195)
  1785.  
  1786.     CASE 3  ' Horizontals DOUBLE / Verticals SINGLE
  1787.  
  1788.         urc$ = CHR$(184): ulc$ = CHR$(213): llc$ = CHR$(212): lrc$ = CHR$(190)
  1789.         ver$ = CHR$(179): hor$ = CHR$(205)
  1790.         vtl$ = CHR$(198): vtr$ = CHR$(181)
  1791.         htt$ = CHR$(209): htb$ = CHR$(207)
  1792.         crs$ = CHR$(216): blk$ = CHR$(219)
  1793.         lbl$ = CHR$(181): lbr$ = CHR$(198)
  1794.  
  1795.     CASE 4  ' Outside lines DOUBLE / Inside lines SINGLE
  1796.  
  1797.         urc$ = CHR$(187): ulc$ = CHR$(201): llc$ = CHR$(200): lrc$ = CHR$(188)
  1798.         ver$ = CHR$(186): ver1$ = CHR$(179): hor$ = CHR$(205): hor1$ = CHR$(196)
  1799.         vtl$ = CHR$(199): vtr$ = CHR$(182)
  1800.         htt$ = CHR$(209): htt1$ = CHR$(194): htb$ = CHR$(207): htb1$ = CHR$(193)
  1801.         crs$ = CHR$(197): blk$ = CHR$(219)
  1802.         lbl$ = CHR$(181): lbr$ = CHR$(198)
  1803.  
  1804.     CASE 5  ' Outside lines SINGLE / Inside Lines DOUBLE
  1805.  
  1806.         urc$ = CHR$(191): ulc$ = CHR$(218): llc$ = CHR$(192): lrc$ = CHR$(217)
  1807.         ver$ = CHR$(179): ver1$ = CHR$(186): hor$ = CHR$(196): hor1$ = CHR$(205)
  1808.         vtl$ = CHR$(198): vtr$ = CHR$(181)
  1809.         htt$ = CHR$(210): htt1$ = CHR$(203): htb$ = CHR$(208): htb1$ = CHR$(202)
  1810.         crs$ = CHR$(206): blk$ = CHR$(219)
  1811.         lbl$ = CHR$(180): lbr$ = CHR$(195)
  1812.  
  1813.     CASE ELSE
  1814.  
  1815.         ' Shouldn't be an "else" !
  1816.  
  1817. END SELECT
  1818.  
  1819. '─────────────────────────────────────────────────────────────────────────
  1820. ' Calculate the number of lines to be printed and redimension Lines$()
  1821. '─────────────────────────────────────────────────────────────────────────
  1822. numLines = (botRow - topRow) + 1
  1823. REDIM line$(numLines)
  1824.  
  1825. '─────────────────────────────────────────────────────────────────────────
  1826. ' Determine ExplodeStep% for explode loop based on ExplodeType%
  1827. '─────────────────────────────────────────────────────────────────────────
  1828. SELECT CASE explodeType%
  1829.  
  1830.     CASE 0  ' Exploding Windows OFF
  1831.         explodeStep% = 0
  1832.  
  1833.     CASE 1  ' Explode automatic - determine explode ratio
  1834.         explodeStep% = INT((rightCol - leftCol) / (botRow - topRow))
  1835.  
  1836.     CASE 2  ' Explode ratio biased toward HORIZONTAL
  1837.         explodeStep% = 3
  1838.  
  1839.     CASE 3  ' Explode ratio biased toward VERTICAL
  1840.         explodeStep% = 1
  1841.  
  1842. END SELECT
  1843.  
  1844. '─────────────────────────────────────────────────────────────────────────
  1845. ' Construct the window strings based on WindowType%
  1846. '─────────────────────────────────────────────────────────────────────────
  1847. SELECT CASE windowType%
  1848.  
  1849.     CASE 0  ' Regular box, no extra lines
  1850.  
  1851.         line$(1) = ulc$ + STRING$((rightCol - leftCol) - 1, hor$) + urc$
  1852.         FOR x% = 2 TO numLines - 1
  1853.             line$(x%) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
  1854.         NEXT x%
  1855.         line$(numLines) = llc$ + STRING$((rightCol - leftCol) - 1, hor$) + lrc$
  1856.  
  1857.     CASE 1  ' Box with extra internal line at top and bottom
  1858.  
  1859.         line$(1) = ulc$ + STRING$((rightCol - leftCol) - 1, hor$) + urc$
  1860.         line$(2) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
  1861.         IF frameType% = 4 OR frameType% = 5 THEN
  1862.             tempHOR$ = hor$
  1863.             hor$ = hor1$
  1864.         END IF
  1865.         line$(3) = vtl$ + STRING$((rightCol - leftCol) - 1, hor$) + vtr$
  1866.         FOR x% = 4 TO numLines - 3
  1867.             line$(x%) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
  1868.         NEXT x%
  1869.         line$(numLines - 2) = vtl$ + STRING$((rightCol - leftCol) - 1, hor$) + vtr$
  1870.         line$(numLines - 1) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
  1871.         IF frameType% = 4 OR frameType% = 5 THEN
  1872.             hor$ = tempHOR$
  1873.         END IF
  1874.         line$(numLines) = llc$ + STRING$((rightCol - leftCol) - 1, hor$) + lrc$
  1875.  
  1876.     CASE 2  ' Box with extra internal line at top
  1877.  
  1878.         line$(1) = ulc$ + STRING$((rightCol - leftCol) - 1, hor$) + urc$
  1879.         line$(2) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
  1880.         IF frameType% = 4 OR frameType% = 5 THEN
  1881.             tempHOR$ = hor$
  1882.             hor$ = hor1$
  1883.         END IF
  1884.         line$(3) = vtl$ + STRING$((rightCol - leftCol) - 1, hor$) + vtr$
  1885.         FOR x% = 4 TO numLines - 1
  1886.             line$(x%) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
  1887.         NEXT x%
  1888.         IF frameType% = 4 OR frameType% = 5 THEN
  1889.             hor$ = tempHOR$
  1890.         END IF
  1891.         line$(numLines) = llc$ + STRING$((rightCol - leftCol) - 1, hor$) + lrc$
  1892.  
  1893.     CASE 3  ' Box with extra internal line at bottom
  1894.  
  1895.         line$(1) = ulc$ + STRING$((rightCol - leftCol) - 1, hor$) + urc$
  1896.         FOR x% = 2 TO numLines - 3
  1897.             line$(x%) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
  1898.         NEXT x%
  1899.         IF frameType% = 4 OR frameType% = 5 THEN
  1900.             tempHOR$ = hor$
  1901.             hor$ = hor1$
  1902.         END IF
  1903.         line$(numLines - 2) = vtl$ + STRING$((rightCol - leftCol) - 1, hor$) + vtr$
  1904.         line$(numLines - 1) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
  1905.         IF frameType% = 4 OR frameType% = 5 THEN
  1906.             hor$ = tempHOR$
  1907.         END IF
  1908.         line$(numLines) = llc$ + STRING$((rightCol - leftCol) - 1, hor$) + lrc$
  1909.    
  1910.     CASE 4  ' Box with vertical line down the center
  1911.  
  1912.         part1 = ((rightCol - leftCol) - 1) / 2
  1913.         IF INT(part1) = part1 THEN
  1914.             part2 = part1 - 1
  1915.         ELSE
  1916.             part1 = INT(part1)
  1917.             part2 = part1
  1918.         END IF
  1919.         line$(1) = ulc$ + STRING$(part1, hor$) + htt$ + STRING$(part2, hor$) + urc$
  1920.         IF frameType% <> 4 AND frameType% <> 5 THEN
  1921.             ver1$ = ver$
  1922.         END IF
  1923.         FOR x% = 2 TO numLines - 1
  1924.             line$(x%) = ver$ + SPACE$(part1) + ver1$ + SPACE$(part2) + ver$
  1925.         NEXT x%
  1926.         line$(numLines) = llc$ + STRING$(part1, hor$) + htb$ + STRING$(part2, hor$) + lrc$
  1927.  
  1928.     CASE 5  ' Box with horizontal line down the center
  1929.  
  1930.         TopHalf = INT(numLines / 2)
  1931.         line$(1) = ulc$ + STRING$((rightCol - leftCol) - 1, hor$) + urc$
  1932.         FOR x% = 2 TO TopHalf
  1933.             line$(x%) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
  1934.         NEXT x%
  1935.         IF frameType% = 4 OR frameType% = 5 THEN
  1936.             tempHOR$ = hor$
  1937.             hor$ = hor1$
  1938.         END IF
  1939.         line$(TopHalf + 1) = vtl$ + STRING$((rightCol - leftCol) - 1, hor$) + vtr$
  1940.         IF frameType% = 4 OR frameType% = 5 THEN
  1941.             hor$ = tempHOR$
  1942.         END IF
  1943.         FOR x% = TopHalf + 2 TO numLines - 1
  1944.             line$(x%) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
  1945.         NEXT x%
  1946.         line$(numLines) = llc$ + STRING$((rightCol - leftCol) - 1, hor$) + lrc$
  1947.  
  1948.     CASE 6  ' Box cross-divided into four sections
  1949.  
  1950.         TopHalf = INT(numLines / 2): part1 = ((rightCol - leftCol) - 1) / 2
  1951.         IF INT(part1) = part1 THEN
  1952.             part2 = part1 - 1
  1953.         ELSE
  1954.             part1 = INT(part1): part2 = part1
  1955.         END IF
  1956.         line$(1) = ulc$ + STRING$(part1, hor$) + htt$ + STRING$(part2, hor$) + urc$
  1957.         IF frameType% <> 4 AND frameType% <> 5 THEN ver1$ = ver$
  1958.         FOR x% = 2 TO TopHalf
  1959.             line$(x%) = ver$ + SPACE$(part1) + ver1$ + SPACE$(part2) + ver$
  1960.         NEXT x%
  1961.         IF frameType% = 4 OR frameType% = 5 THEN
  1962.             tempHOR$ = hor$: hor$ = hor1$
  1963.         END IF
  1964.         line$(TopHalf + 1) = vtl$ + STRING$(part1, hor$) + crs$ + STRING$(part2, hor$) + vtr$
  1965.         IF frameType% = 4 OR frameType% = 5 THEN hor$ = tempHOR$
  1966.         FOR x% = TopHalf + 2 TO numLines - 1
  1967.             line$(x%) = ver$ + SPACE$(part1) + ver1$ + SPACE$(part2) + ver$
  1968.         NEXT x%
  1969.         line$(numLines) = llc$ + STRING$(part1, hor$) + htb$ + STRING$(part2, hor$) + lrc$
  1970.  
  1971.     CASE 7  ' Box with extra internal line at top and vertical
  1972.             ' dividing line for rest of window
  1973.  
  1974.         part1 = ((rightCol - leftCol) - 1) / 2
  1975.         IF INT(part1) = part1 THEN
  1976.             part2 = part1 - 1
  1977.         ELSE
  1978.             part1 = INT(part1)
  1979.             part2 = part1
  1980.         END IF
  1981.         line$(1) = ulc$ + STRING$((rightCol - leftCol) - 1, hor$) + urc$
  1982.         line$(2) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
  1983.         IF frameType% <> 4 AND frameType% <> 5 THEN
  1984.             htt1$ = htt$
  1985.             ver1$ = ver$
  1986.             hor1$ = hor$
  1987.         END IF
  1988.         line$(3) = vtl$ + STRING$(part1, hor1$) + htt1$ + STRING$(part2, hor1$) + vtr$
  1989.         FOR x% = 4 TO numLines - 1
  1990.             line$(x%) = ver$ + SPACE$(part1) + ver1$ + SPACE$(part2) + ver$
  1991.         NEXT x%
  1992.         line$(numLines) = llc$ + STRING$(part1, hor$) + htb$ + STRING$(part2, hor$) + lrc$
  1993.  
  1994.     CASE 8  ' Box with extra internalline at bottom and vertical
  1995.             ' dividing line for rest of window
  1996.  
  1997.         part1 = ((rightCol - leftCol) - 1) / 2
  1998.         IF INT(part1) = part1 THEN
  1999.             part2 = part1 - 1
  2000.         ELSE
  2001.             part1 = INT(part1)
  2002.             part2 = part1
  2003.         END IF
  2004.         line$(1) = ulc$ + STRING$(part1, hor$) + htt$ + STRING$(part2, hor$) + urc$
  2005.         IF frameType% <> 4 AND frameType% <> 5 THEN
  2006.             htb1$ = htb$
  2007.             ver1$ = ver$
  2008.             hor1$ = hor$
  2009.         END IF
  2010.         FOR x% = 2 TO numLines - 3
  2011.             line$(x%) = ver$ + SPACE$(part1) + ver1$ + SPACE$(part2) + ver$
  2012.         NEXT x%
  2013.         line$(numLines - 2) = vtl$ + STRING$(part1, hor1$) + htb1$ + STRING$(part2, hor1$) + vtr$
  2014.         line$(numLines - 1) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
  2015.         line$(numLines) = llc$ + STRING$((rightCol - leftCol) - 1, hor$) + lrc$
  2016.  
  2017.     CASE 9  ' Box with extra internal lines at top and bottom,
  2018.             ' with dividing line for rest of window
  2019.  
  2020.         part1 = ((rightCol - leftCol) - 1) / 2
  2021.         IF INT(part1) = part1 THEN
  2022.             part2 = part1 - 1
  2023.         ELSE
  2024.             part1 = INT(part1)
  2025.             part2 = part1
  2026.         END IF
  2027.         line$(1) = ulc$ + STRING$((rightCol - leftCol) - 1, hor$) + urc$
  2028.         line$(2) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
  2029.         IF frameType% <> 4 AND frameType% <> 5 THEN
  2030.             htt1$ = htt$
  2031.             htb1$ = htb$
  2032.             ver1$ = ver$
  2033.             hor1$ = hor$
  2034.         END IF
  2035.         line$(3) = vtl$ + STRING$(part1, hor1$) + htt1$ + STRING$(part2, hor1$) + vtr$
  2036.         FOR x% = 4 TO numLines - 3
  2037.             line$(x%) = ver$ + SPACE$(part1) + ver1$ + SPACE$(part2) + ver$
  2038.         NEXT x%
  2039.         line$(numLines - 2) = vtl$ + STRING$(part1, hor1$) + htb1$ + STRING$(part2, hor1$) + vtr$
  2040.         line$(numLines - 1) = ver$ + SPACE$((rightCol - leftCol) - 1) + ver$
  2041.         line$(numLines) = llc$ + STRING$((rightCol - leftCol) - 1, hor$) + lrc$
  2042.  
  2043.     CASE ELSE
  2044.  
  2045.     '─────────────────────────────────────────────────────────────────────
  2046.     ' Shouldn't be an "else" !
  2047.     '─────────────────────────────────────────────────────────────────────
  2048.  
  2049. END SELECT
  2050.  
  2051. '─────────────────────────────────────────────────────────────────────────
  2052. ' Print the Window, Please!  Set colors to those passed to MakeWindow
  2053. '─────────────────────────────────────────────────────────────────────────
  2054. COLOR foreColor%, backColor%
  2055.  
  2056. '─────────────────────────────────────────────────────────────────────────
  2057. ' Print the window on the screen, using method based on ExplodeType%
  2058. '─────────────────────────────────────────────────────────────────────────
  2059. SELECT CASE explodeType%
  2060.  
  2061.     CASE 0  ' No explosion - just a straight print.  See how easy?
  2062.  
  2063.         FOR x% = 1 TO numLines
  2064.             LOCATE (x% + (topRow - 1)), leftCol: PRINT line$(x%);
  2065.         NEXT x%
  2066.  
  2067.     CASE 1, 2, 3  ' Explode that window!
  2068.  
  2069.         expX1% = INT(((rightCol - leftCol) / 2) + leftCol): expX2% = expX1%
  2070.         expY1% = INT(((botRow - topRow) / 2) + topRow): expY2% = expY1%
  2071.         WHILE (expX1% > leftCol + 1) OR (expY1% > topRow + 1)
  2072.             IF expX1% > leftCol THEN expX1% = expX1% - explodeStep%
  2073.             IF expX2% < rightCol THEN expX2% = expX2% + explodeStep%
  2074.             IF expY1% > topRow THEN expY1% = expY1% - 1
  2075.             IF expY2% < botRow THEN expY2% = expY2% + 1
  2076.             IF expX1% < leftCol THEN expX1% = leftCol: expX2% = rightCol
  2077.             IF expY1% < topRow THEN expY1% = topRow: expY2% = botRow
  2078.             LOCATE expY1%, expX1%: PRINT ulc$ + STRING$((expX2% - expX1%) - 1, hor$) + urc$;
  2079.             FOR x% = expY1% + 1 TO expY2% - 1
  2080.                 LOCATE x%, expX1%: PRINT ver$ + SPACE$((expX2% - expX1%) - 1) + ver$;
  2081.             NEXT x%
  2082.             LOCATE expY2%, expX1%: PRINT llc$ + STRING$((expX2% - expX1%) - 1, hor$) + lrc$;
  2083.         WEND
  2084.  
  2085.         '─────────────────────────────────────────────────────────────────
  2086.         ' Print a straight window now, after the explosion effect
  2087.         '─────────────────────────────────────────────────────────────────
  2088.         FOR x% = 1 TO numLines
  2089.             LOCATE (x% + (topRow - 1)), leftCol: PRINT line$(x%);
  2090.         NEXT x%
  2091.  
  2092.     CASE ELSE
  2093.  
  2094.     '─────────────────────────────────────────────────────────────────────
  2095.     ' Shouldn't be an "else" !
  2096.     '─────────────────────────────────────────────────────────────────────
  2097.  
  2098. END SELECT
  2099.  
  2100. '─────────────────────────────────────────────────────────────────────────
  2101. ' Add a shadow if required
  2102. '─────────────────────────────────────────────────────────────────────────
  2103. SELECT CASE shadowColor%
  2104. CASE 0 TO 15
  2105.   
  2106.     '─────────────────────────────────────────────────────────────────────
  2107.     ' Change colors to ShadowColor%
  2108.     '─────────────────────────────────────────────────────────────────────
  2109.     COLOR shadowColor%, 0
  2110.    
  2111.     '─────────────────────────────────────────────────────────────────────
  2112.     ' Define the characters to display for the side/bottom shadow
  2113.     '─────────────────────────────────────────────────────────────────────
  2114.     sideShadow$ = STRING$(2, 219)
  2115.     botShadow$ = STRING$((rightCol - leftCol), 219)
  2116.    
  2117.     '─────────────────────────────────────────────────────────────────────
  2118.     ' Print the side shadow
  2119.     '─────────────────────────────────────────────────────────────────────
  2120.     FOR x% = topRow + 1 TO botRow + 1
  2121.         LOCATE x%, rightCol + 1: PRINT sideShadow$;
  2122.     NEXT x%
  2123.  
  2124.     '─────────────────────────────────────────────────────────────────────
  2125.     ' Print the bottom shadow
  2126.     '─────────────────────────────────────────────────────────────────────
  2127.     LOCATE botRow + 1, leftCol + 2: PRINT botShadow$;
  2128.  
  2129. CASE 16
  2130.  
  2131.     '─────────────────────────────────────────────────────────────────────────
  2132.     ' If shadow color is 16 use special shadow
  2133.     '─────────────────────────────────────────────────────────────────────────
  2134.  
  2135.     'Side shadow
  2136.     segment = GetVideoSegment
  2137.     FOR x% = topRow TO botRow
  2138.         offset% = (160 * x%) + (rightCol * 2) + 1
  2139.         DEF SEG = segment
  2140.         POKE offset%, 7
  2141.         POKE offset% + 2, 7
  2142.         DEF SEG
  2143.     NEXT x%
  2144.     'Bottom shadow
  2145.     offset% = (botRow * 160)
  2146.     FOR x% = ((leftCol + 1) * 2) TO ((rightCol + 1) * 2) STEP 2
  2147.         DEF SEG = segment
  2148.         POKE offset% + x% + 1, 7
  2149.         DEF SEG
  2150.     NEXT x%
  2151. CASE ELSE
  2152. END SELECT    ' shadowColor%
  2153.  
  2154. '─────────────────────────────────────────────────────────────────────────
  2155. ' Add the Window Label, if possible.  Set the colors to those passed
  2156. ' to MakeWindow routine.
  2157. '─────────────────────────────────────────────────────────────────────────
  2158. COLOR foreColor%, backColor%
  2159.  
  2160. '─────────────────────────────────────────────────────────────────────────
  2161. ' Add label to window if one was specified
  2162. '─────────────────────────────────────────────────────────────────────────
  2163. IF label$ <> "" THEN
  2164.     label$ = lbl$ + label$ + lbr$
  2165.     LOCATE topRow, leftCol + 1
  2166.     PRINT label$;
  2167. END IF
  2168.  
  2169. END SUB
  2170.  
  2171. REM $STATIC
  2172. SUB MultiMenu (menusArray$(), numEntries%(), menuTitles$(), justify$, marker$, shadowCode%, fg%, bg%, hfg%, hbg%, qfg%, qbg%, menuSelected%, menuEntrySelected%)
  2173.   
  2174.     '┌──────────────────────────────────────────────────────────────────┐
  2175.     '│  This routine allows you to create a pull down menu system for   │
  2176.     '│  any program.  The parameters are as follows:                    │
  2177.     '│                                                                  │
  2178.     '│      menusArray$() - A 2-dimensional array that stores all the   │
  2179.     '│                      entries for each menu.  The FIRST index     │
  2180.     '│                      indicates the particular MENU, while the    │
  2181.     '│                      SECOND index indicates the particular entry │
  2182.     '│                      for the menu indicated by the FIRST index.  │
  2183.     '│      numEntries%() - A 1-dimensional array that contains the     │
  2184.     '│                      number of actual entries for each menu.     │
  2185.     '│                      The index for this array indicates which    │
  2186.     '│                      menu you're talking about.                  │
  2187.     '│      menuTitles$() - A 1-dimensional array that stores the       │
  2188.     '│                      title of each menu.                         │
  2189.     '│      justify$      - A single text character indicating the type │
  2190.     '│                      of justification to use when displaying the │
  2191.     '│                      menu will use when displaying the entries   │
  2192.     '│                      of each sub-menu.  The valid values are:    │
  2193.     '│                                  "C" - Centered                  │
  2194.     '│                                  "L" - Left justified            │
  2195.     '│                                  "R" - Right justified           │
  2196.     '│      marker$       - A single character used to identify the     │
  2197.     '│                      "Quick Access" key for each menu entry.     │
  2198.     '│      shadowCode%   - A value indicating the type of shadowing    │
  2199.     '│                      to use for the menu windows.  Valid values: │
  2200.     '│                            -1   - No shadow at all               │
  2201.     '│                            0-15 - Shadow of this color           │
  2202.     '│                            16   - Special character shadow       │
  2203.     '│      fg%, bg%      - The foreground and background colors of the │
  2204.     '│                      normal, unhighlighted menu entries          │
  2205.     '│      hfg%, hbg%    - The foreground and background colors of the │
  2206.     '│                      highlighted menu entries                    │
  2207.     '│      qfg%, qbg%    - The foreground and background colors of the │
  2208.     '│                      "Quick Access" letters                      │
  2209.     '│      menuSelected% - This variable is an "out" parameter.  It    │
  2210.     '│                      has no value when you call the routine.     │
  2211.     '│                      When the MultiMenu returns to the calling   │
  2212.     '│                      routine, this variable will contain the     │
  2213.     '│                      number of the menu the user made his/her    │
  2214.     '│                      selection from.                             │
  2215.     '│      menuEntrySelected% - This variable is an "out" parameter.   │
  2216.     '│                      It has no value when you call the routine.  │
  2217.     '│                      When the MultiMenu returns to the calling   │
  2218.     '│                      routine, this variable will contain the     │
  2219.     '│                      number of the entry the user selected on    │
  2220.     '│                      the menu indicated by menuSelected%.        │
  2221.     '│                                                                  │
  2222.     '│  See the QBSCR Screen Routines documentation for more details.   │
  2223.     '└──────────────────────────────────────────────────────────────────┘
  2224.  
  2225.     '────────────────────────────────────────────────────────────────────
  2226.     ' Define special keys
  2227.     '────────────────────────────────────────────────────────────────────
  2228.     leftArrow$ = CHR$(0) + CHR$(75)
  2229.     rightArrow$ = CHR$(0) + CHR$(77)
  2230.     downArrow$ = CHR$(0) + CHR$(80)
  2231.     homeKey$ = CHR$(0) + CHR$(71)
  2232.     endKey$ = CHR$(0) + CHR$(79)
  2233.     enter$ = CHR$(13)
  2234.     esc$ = CHR$(27)
  2235.    
  2236.     '────────────────────────────────────────────────────────────────────
  2237.     ' Determine number of menus
  2238.     '────────────────────────────────────────────────────────────────────
  2239.     numMenus% = UBOUND(menusArray$, 1)
  2240.    
  2241.     '────────────────────────────────────────────────────────────────────
  2242.     ' Determine all QuickAccess keys for the menu titles
  2243.     '────────────────────────────────────────────────────────────────────
  2244.     DIM charID(1 TO numMenus%) AS STRING * 1
  2245.     FOR x% = 1 TO numMenus%
  2246.         FOR y% = 1 TO LEN(menuTitles$(x%))
  2247.             IF MID$(menuTitles$(x%), y%, 1) = marker$ THEN
  2248.                 charID(x%) = UCASE$(MID$(menuTitles$(x%), y% + 1, 1))
  2249.                 EXIT FOR
  2250.             END IF
  2251.         NEXT y%
  2252.     NEXT x%
  2253.    
  2254.     '────────────────────────────────────────────────────────────────────
  2255.     ' Display pull-down menus line
  2256.     '────────────────────────────────────────────────────────────────────
  2257.     COLOR fg%, bg%
  2258.     LOCATE 1, 1, 0: PRINT SPACE$(80);
  2259.     colCount% = 0
  2260.     FOR x% = 1 TO numMenus%
  2261.         LOCATE 1, 2 + colCount%, 0: DisplayEntry menuTitles$(x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
  2262.         colCount% = colCount% + LEN(menuTitles$(x%)) + 1
  2263.     NEXT x%
  2264.    
  2265.     '────────────────────────────────────────────────────────────────────
  2266.     ' Display highlight for first entry
  2267.     '────────────────────────────────────────────────────────────────────
  2268.     COLOR hfg%, hbg%
  2269.     LOCATE 1, 2, 0: DisplayEntry menuTitles$(1), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
  2270.    
  2271.     '────────────────────────────────────────────────────────────────────
  2272.     ' Wait for keystrokes
  2273.     '────────────────────────────────────────────────────────────────────
  2274.     currentMenu% = 1
  2275.     oldMenu% = 1
  2276.     done% = FALSE
  2277.     DO
  2278.         DO
  2279.             k$ = UCASE$(INKEY$)
  2280.         LOOP UNTIL k$ <> ""
  2281.         SELECT CASE k$
  2282.         CASE leftArrow$       ' Move highlight to the left
  2283.             IF currentMenu% > 1 THEN
  2284.                 currentMenu% = currentMenu% - 1
  2285.             ELSE
  2286.                 currentMenu% = numMenus%
  2287.             END IF
  2288.         CASE rightArrow$      ' Move highlight to the right
  2289.             IF currentMenu% < numMenus% THEN
  2290.                 currentMenu% = currentMenu% + 1
  2291.             ELSE
  2292.                 currentMenu% = 1
  2293.             END IF
  2294.         CASE homeKey$
  2295.             currentMenu% = 1
  2296.         CASE endKey$
  2297.             currentMenu% = numMenus%
  2298.         CASE enter$, downArrow$  ' Use the current menu and exit DO
  2299.             done% = TRUE
  2300.         CASE esc$             ' Abort MultiMenu call
  2301.             menuSelected% = 0
  2302.             menuEntrySelected% = 0
  2303.             EXIT SUB
  2304.         CASE ELSE
  2305.             '────────────────────────────────────────────────────────────
  2306.             ' Check for special quick access keys
  2307.             '────────────────────────────────────────────────────────────
  2308.             FOR x% = 1 TO numMenus%
  2309.                 IF k$ = charID(x%) THEN
  2310.                     currentMenu% = x%
  2311.                     done% = TRUE
  2312.                     EXIT FOR
  2313.                 END IF
  2314.             NEXT x%
  2315.         END SELECT
  2316.        
  2317.         '────────────────────────────────────────────────────────────────
  2318.         ' Update highlight
  2319.         '────────────────────────────────────────────────────────────────
  2320.         colCount% = 0
  2321.         FOR x% = 1 TO oldMenu% - 1
  2322.             colCount% = colCount% + LEN(menuTitles$(x%)) + 1
  2323.         NEXT x%
  2324.         LOCATE 1, 2 + colCount%, 0: DisplayEntry menuTitles$(x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
  2325.         oldMenu% = currentMenu%
  2326.         colCount% = 0
  2327.         FOR x% = 1 TO currentMenu% - 1
  2328.             colCount% = colCount% + LEN(menuTitles$(x%)) + 1
  2329.         NEXT x%
  2330.         LOCATE 1, 2 + colCount%, 0: DisplayEntry menuTitles$(x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
  2331.  
  2332.     LOOP UNTIL done%
  2333.    
  2334.     '────────────────────────────────────────────────────────────────────
  2335.     ' Now we know the first menu to display.  Loop while the user hits
  2336.     ' the left or right arrow keys
  2337.     '────────────────────────────────────────────────────────────────────
  2338.     done% = FALSE
  2339.     DO
  2340.         '────────────────────────────────────────────────────────────────
  2341.         ' Calculate the longest menu entry in the list
  2342.         '────────────────────────────────────────────────────────────────
  2343.         longestEntry% = 0
  2344.         FOR x% = 1 TO numEntries%(currentMenu%)
  2345.             IF longestEntry% < LEN(menusArray$(currentMenu%, x%)) THEN
  2346.                 longestEntry% = LEN(menusArray$(currentMenu%, x%))
  2347.             END IF
  2348.         NEXT x%
  2349.        
  2350.         '────────────────────────────────────────────────────────────────
  2351.         ' Calculate box dimensions
  2352.         '────────────────────────────────────────────────────────────────
  2353.         lft% = colCount% + 1
  2354.         IF lft% < 1 THEN
  2355.             lft% = 1
  2356.         END IF
  2357.         rght% = lft% + longestEntry% + 2
  2358.         IF rght% > 78 THEN
  2359.             lft% = lft% - (rght% - 78)
  2360.             rght% = 78
  2361.         END IF
  2362.         top% = 2
  2363.         bot% = top% + numEntries%(currentMenu%) + 1
  2364.  
  2365.         '────────────────────────────────────────────────────────────────
  2366.         ' Save area of the screen that the window overwrites
  2367.         '────────────────────────────────────────────────────────────────
  2368.         REDIM blockArray%(BlockSize%(lft%, rght% + 2, top%, bot% + 1))
  2369.         BlockSave lft%, rght% + 2, top%, bot% + 1, blockArray%(), GetVideoSegment
  2370.        
  2371.         '────────────────────────────────────────────────────────────────
  2372.         ' Make the window to hold the entries
  2373.         '────────────────────────────────────────────────────────────────
  2374.         MakeWindow CSNG(top%), CSNG(lft%), CSNG(bot%), CSNG(rght%), fg%, bg%, 0, 0, shadowCode%, 0, ""
  2375.        
  2376.         '────────────────────────────────────────────────────────────────
  2377.         ' Make the menu for the current menu
  2378.         '────────────────────────────────────────────────────────────────
  2379.         choice% = SubMenu%(menusArray$(), currentMenu%, numEntries%(currentMenu%), justify$, lft% + 2, rght% - 2, 3, marker$, fg%, bg%, hfg%, hbg%, qfg%, qbg%)
  2380.  
  2381.         '────────────────────────────────────────────────────────────────
  2382.         ' Decide what to do based on the returned value of the call to
  2383.         ' the SubMenu function, which handles the individual menus
  2384.         '────────────────────────────────────────────────────────────────
  2385.         SELECT CASE choice%
  2386.         CASE LEFTARROWCODE   ' Move to the next menu to the left
  2387.             IF currentMenu% > 1 THEN
  2388.                 currentMenu% = currentMenu% - 1
  2389.             ELSE
  2390.                 currentMenu% = numMenus%
  2391.             END IF
  2392.         CASE RIGHTARROWCODE  ' Move to the next menu to the right
  2393.             IF currentMenu% < numMenus% THEN
  2394.                 currentMenu% = currentMenu% + 1
  2395.             ELSE
  2396.                 currentMenu% = 1
  2397.             END IF
  2398.         CASE 1 TO numEntries%(currentMenu%)   ' See if an entry from the menu
  2399.             menuEntrySelected% = choice%      ' was selected
  2400.             menuSelected% = currentMenu%
  2401.             EXIT SUB
  2402.         CASE 27    ' Escape ∙ Abort the menu
  2403.             menuEntrySelected% = 0
  2404.             menuSelected% = 0
  2405.             done% = TRUE
  2406.         CASE ELSE
  2407.         END SELECT
  2408.        
  2409.         '────────────────────────────────────────────────────────────────
  2410.         ' Update highlight
  2411.         '────────────────────────────────────────────────────────────────
  2412.         colCount% = 0
  2413.         FOR x% = 1 TO oldMenu% - 1
  2414.             colCount% = colCount% + LEN(menuTitles$(x%)) + 1
  2415.         NEXT x%
  2416.         LOCATE 1, 2 + colCount%, 0: DisplayEntry menuTitles$(x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
  2417.         oldMenu% = currentMenu%
  2418.         colCount% = 0
  2419.         FOR x% = 1 TO currentMenu% - 1
  2420.             colCount% = colCount% + LEN(menuTitles$(x%)) + 1
  2421.         NEXT x%
  2422.         LOCATE 1, 2 + colCount%, 0: DisplayEntry menuTitles$(x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
  2423.        
  2424.         '────────────────────────────────────────────────────────────────
  2425.         ' Restore screen block
  2426.         '────────────────────────────────────────────────────────────────
  2427.         BlockRestore lft%, rght% + 2, top%, bot% + 1, blockArray%(), GetVideoSegment
  2428.        
  2429.     LOOP UNTIL done%
  2430.  
  2431. END SUB
  2432.  
  2433. SUB OffCenter (st$, row%, leftCol%, rightCol%)
  2434.  
  2435. '┌────────────────────────────────────────────────────────────────────────┐
  2436. '│  This routine will center the text passed to it on the screen between  │
  2437. '│  two specified columns.  Excellent for centering text in a window      │
  2438. '│  that itself is not centered in the screen.  Parameters are:           │
  2439. '│                                                                        │
  2440. '│      st$ - the string to center.  Maximum length of string is 80       │
  2441. '│            characters.                                                 │
  2442. '│      row% - The row on which the string will be centered.  Allowable   │
  2443. '│             range is 1 through 25.                                     │
  2444. '│      leftCol! - The left-most column to center the text between.       │
  2445. '│                 Allowable range is 1 through 79.                       │
  2446. '│      rightCol! - The right-most column to center the text between.     │
  2447. '│                  Allowable range is 2 through 80.                      │
  2448. '└────────────────────────────────────────────────────────────────────────┘
  2449.  
  2450. '─────────────────────────────────────────────────────────────────────────
  2451. ' Calculate width available for string
  2452. '─────────────────────────────────────────────────────────────────────────
  2453. wdth% = (rightCol% - leftCol%)
  2454.  
  2455. '─────────────────────────────────────────────────────────────────────────
  2456. ' If ST$ fits in available width, determine X% for Locate.  Otherwise,
  2457. ' quit the routine.
  2458. '─────────────────────────────────────────────────────────────────────────
  2459. IF LEN(st$) > wdth% THEN
  2460.     EXIT SUB
  2461. ELSE
  2462.     x% = INT(((wdth% - (LEN(st$))) \ 2) + leftCol%) + 1
  2463. END IF
  2464.  
  2465. '─────────────────────────────────────────────────────────────────────────
  2466. ' Print the string
  2467. '─────────────────────────────────────────────────────────────────────────
  2468. LOCATE row%, x%: PRINT st$;
  2469.  
  2470. END SUB
  2471.  
  2472. SUB PutScreen (file$)
  2473.  
  2474.     '┌──────────────────────────────────────────────────────────────────┐
  2475.     '│  This subprogram will copy the contents of a file that was saved │
  2476.     '│  using the QBSCR GetScreen subprogram (or Screen Builder)into    │
  2477.     '│  video RAM.  The result is a very fast retrieval and display of  │
  2478.     '│  a video screen.                                                 │
  2479.     '└──────────────────────────────────────────────────────────────────┘
  2480.    
  2481.     '────────────────────────────────────────────────────────────────────
  2482.     ' Set the memory segment to the address of screen memory
  2483.     '────────────────────────────────────────────────────────────────────
  2484.     DEF SEG = GetVideoSegment
  2485.  
  2486.     '────────────────────────────────────────────────────────────────────
  2487.     ' Use the BASIC BLOAD statement to load the saved screen to video RAM
  2488.     '────────────────────────────────────────────────────────────────────
  2489.     LOCATE 1, 1, 0
  2490.     BLOAD file$, 0
  2491.  
  2492.     '────────────────────────────────────────────────────────────────────
  2493.     ' Restore BASIC's default data segment
  2494.     '────────────────────────────────────────────────────────────────────
  2495.     DEF SEG
  2496.  
  2497. END SUB
  2498.  
  2499. SUB QBPrint (st$, row%, col%, fore%, back%)
  2500.  
  2501.     '──────────────────────────────────────────────────────────────────────
  2502.     ' Calculate video memory offset, where display will begin
  2503.     '──────────────────────────────────────────────────────────────────────
  2504.     offset% = 160 * (row% - 1) + 2 * (col% - 1)
  2505.  
  2506.     '──────────────────────────────────────────────────────────────────────
  2507.     ' Calculate color byte for string
  2508.     '──────────────────────────────────────────────────────────────────────
  2509.     IF fore% > 15 THEN
  2510.         blinkingFore% = TRUE
  2511.         fore% = fore% - 16
  2512.     ELSE
  2513.         blinkingFore% = FALSE
  2514.     END IF
  2515.     attribute% = (back% * 16) + fore%
  2516.     IF blinkingFore% THEN
  2517.         attribute% = attribute% + 128
  2518.     END IF
  2519.  
  2520.     '──────────────────────────────────────────────────────────────────────
  2521.     ' Set default data segment to screen memory
  2522.     '──────────────────────────────────────────────────────────────────────
  2523.     DEF SEG = GetVideoSegment
  2524.  
  2525.     '──────────────────────────────────────────────────────────────────────
  2526.     ' Place the string into video memory, along with the color
  2527.     '──────────────────────────────────────────────────────────────────────
  2528.     stPos% = 1
  2529.     FOR x% = 0 TO ((LEN(st$) - 1) * 2) STEP 2
  2530.         POKE x% + offset%, ASC(MID$(st$, stPos%, 1))
  2531.         POKE x% + offset% + 1, attribute%
  2532.         stPos% = stPos% + 1
  2533.     NEXT x%
  2534.  
  2535.     '──────────────────────────────────────────────────────────────────────
  2536.     ' Restore BASIC's default data segment
  2537.     '──────────────────────────────────────────────────────────────────────
  2538.     DEF SEG
  2539.  
  2540. END SUB
  2541.  
  2542. FUNCTION ScreenBlank$ (delay)
  2543.  
  2544. '┌────────────────────────────────────────────────────────────────────────┐
  2545. '│  This routine blanks out the screen and displays a message informing   │
  2546. '│  the user of this.  To prevent this message from burning into the      │
  2547. '│  screen, it changes place periodically.  The Delay parameter is a      │
  2548. '│  numerical variable used in a dummy wait loop.  Change this value      │
  2549. '│  based on the speed of your machine.  This routine returns the key     │
  2550. '│  the user pressed to restore the screen, in case you want to use it.   │
  2551. '└────────────────────────────────────────────────────────────────────────┘
  2552.  
  2553. '─────────────────────────────────────────────────────────────────────────
  2554. ' Seed the random number generator with the TIMER function
  2555. '─────────────────────────────────────────────────────────────────────────
  2556. RANDOMIZE TIMER
  2557.  
  2558. '─────────────────────────────────────────────────────────────────────────
  2559. ' Initialize local variables, set colors and clear the screen
  2560. '─────────────────────────────────────────────────────────────────────────
  2561. blankCount = 0: key$ = "": COLOR 7, 0: CLS
  2562.  
  2563. '─────────────────────────────────────────────────────────────────────────
  2564. ' Display the informational message
  2565. '─────────────────────────────────────────────────────────────────────────
  2566. GOSUB BounceMessage
  2567.  
  2568. '─────────────────────────────────────────────────────────────────────────
  2569. ' While the user has not hit a key, increment our delay counter
  2570. '─────────────────────────────────────────────────────────────────────────
  2571. WHILE key$ = ""
  2572.  
  2573.     key$ = INKEY$
  2574.     blankCount = blankCount + 1
  2575.    
  2576.     '─────────────────────────────────────────────────────────────────────
  2577.     ' If our counter reaches our delay, then move the screen message
  2578.     '─────────────────────────────────────────────────────────────────────
  2579.     IF blankCount > delay THEN
  2580.  
  2581.         blankCount = 0: CLS
  2582.         GOSUB BounceMessage
  2583.  
  2584.     END IF
  2585.  
  2586. WEND
  2587.  
  2588. '─────────────────────────────────────────────────────────────────────────
  2589. ' Assign the key hit to the function and exit
  2590. '─────────────────────────────────────────────────────────────────────────
  2591. ScreenBlank$ = key$
  2592. EXIT FUNCTION
  2593.  
  2594. '─────────────────────────────────────────────────────────────────────────
  2595. ' This little subroutine moves the informational message to a new
  2596. ' location on the screen
  2597. '─────────────────────────────────────────────────────────────────────────
  2598. BounceMessage:
  2599.  
  2600. '─────────────────────────────────────────────────────────────────────────
  2601. ' Clear the screen
  2602. '─────────────────────────────────────────────────────────────────────────
  2603. CLS
  2604.  
  2605. '─────────────────────────────────────────────────────────────────────────
  2606. ' Calculate new X and Y coordinates for the message randomly
  2607. '─────────────────────────────────────────────────────────────────────────
  2608. xCoord% = INT(RND(1) * 38) + 1
  2609. yCoord% = INT(RND(1) * 24) + 1
  2610.  
  2611. '─────────────────────────────────────────────────────────────────────────
  2612. ' Display the message at the new X and Y coordinates
  2613. '─────────────────────────────────────────────────────────────────────────
  2614. LOCATE yCoord%, xCoord%, 0: PRINT "Screen has been blanked to prevent burn-in.";
  2615. LOCATE yCoord% + 1, xCoord%, 0: PRINT "         Hit any key to return...";
  2616.  
  2617. '─────────────────────────────────────────────────────────────────────────
  2618. ' Return to the wait loop
  2619. '─────────────────────────────────────────────────────────────────────────
  2620. RETURN
  2621.  
  2622. END FUNCTION
  2623.  
  2624. SUB ScrnRestore (firstLine%, lastLine%, scrArray%(), segment)
  2625.  
  2626. '┌────────────────────────────────────────────────────────────────────────┐
  2627. '│  This routine will restore all or a portion of the screen display from │
  2628. '│  an integer array.  For more implementation details, see the QBSCR     │
  2629. '│  reference manual.                                                     │
  2630. '│                                                                        │
  2631. '│  Parameters are as follows:                                            │
  2632. '│                                                                        │
  2633. '│      firstLine%  - The first line of the display where restore should  │
  2634. '│                    begin.  Top line is 1, bottom is 25.                │
  2635. '│      lastLine%   - The last line of the display where restore should   │
  2636. '│                    end, LastLine% being included.                      │
  2637. '│      scrArray%() - The array in which the display contents will be     │
  2638. '│                    restored.  Must be integer, and must be dimensioned │
  2639. '│                    to 3999 (or 4000) elements.                         │
  2640. '└────────────────────────────────────────────────────────────────────────┘
  2641.  
  2642. '──────────────────────────────────────────────────────────────────────────
  2643. ' Determine the starting address in the video memory (start%).  Must use
  2644. ' 160 for the length of a line, since an attribute byte is stored for each
  2645. ' character on the screen (80 characters + 80 attributes = 160)
  2646. '──────────────────────────────────────────────────────────────────────────
  2647. start% = (firstLine% - 1) * 160
  2648.  
  2649. '──────────────────────────────────────────────────────────────────────────
  2650. ' Calculate the length of the block of addresses we must restore (length%).
  2651. ' 1 is subtracted since the array starts with element 0.
  2652. '──────────────────────────────────────────────────────────────────────────
  2653. length% = (((lastLine% - firstLine%) + 1) * 160) - 1
  2654.  
  2655. '──────────────────────────────────────────────────────────────────────────
  2656. ' Set the default segment to the video memory segment.
  2657. '──────────────────────────────────────────────────────────────────────────
  2658. DEF SEG = segment
  2659.  
  2660. '──────────────────────────────────────────────────────────────────────────
  2661. ' Restore information (characters and attributes) to video memory.
  2662. '──────────────────────────────────────────────────────────────────────────
  2663. FOR i% = 0 TO length%
  2664.      POKE start% + i%, scrArray%(start% + i%)
  2665. NEXT i%
  2666.  
  2667. '──────────────────────────────────────────────────────────────────────────
  2668. ' Restore default segment to BASIC's segment.
  2669. '──────────────────────────────────────────────────────────────────────────
  2670. DEF SEG
  2671.  
  2672. END SUB
  2673.  
  2674. SUB ScrnSave (firstLine%, lastLine%, scrArray%(), segment)
  2675.  
  2676. '┌────────────────────────────────────────────────────────────────────────┐
  2677. '│  This routine will save all or a portion of the screen display to an   │
  2678. '│  integer array.  For more implementation details, see the QBSCR        │
  2679. '│  reference manual.                                                     │
  2680. '│                                                                        │
  2681. '│  Parameters are as follows:                                            │
  2682. '│                                                                        │
  2683. '│      firstLine%  - The first line of the display where saving should   │
  2684. '│                    begin.  Top line is 1, bottom is 25.                │
  2685. '│      lastLine%   - The last line of the display where saving should    │
  2686. '│                    end, LastLine% being included.                      │
  2687. '│      scrArray%() - The array in which the display contents will be     │
  2688. '│                    stored.  Must be integer, and must be dimensioned   │
  2689. '│                    to 3999 (or 4000) elements.                         │
  2690. '└────────────────────────────────────────────────────────────────────────┘
  2691.  
  2692. '──────────────────────────────────────────────────────────────────────────
  2693. ' Determine the starting address in the video memory (start%).  Must use
  2694. ' 160 for the length of a line, since an attribute byte is stored for each
  2695. ' character on the screen (80 characters + 80 attributes = 160)
  2696. '──────────────────────────────────────────────────────────────────────────
  2697. start% = (firstLine% - 1) * 160
  2698.  
  2699. '──────────────────────────────────────────────────────────────────────────
  2700. ' Calculate the length of the block of addresses we must retrieve and
  2701. ' store (length%).  1 is subtracted since the array starts with element 0.
  2702. '──────────────────────────────────────────────────────────────────────────
  2703. length% = (((lastLine% - firstLine%) + 1) * 160) - 1
  2704.  
  2705. '──────────────────────────────────────────────────────────────────────────
  2706. ' Set the default segment to the video memory segment.
  2707. '──────────────────────────────────────────────────────────────────────────
  2708. DEF SEG = segment
  2709.  
  2710. '──────────────────────────────────────────────────────────────────────────
  2711. ' Get information (characters and attributes) from video memory.
  2712. '──────────────────────────────────────────────────────────────────────────
  2713. FOR i% = 0 TO length%
  2714.     scrArray%(start% + i%) = PEEK(start% + i%)
  2715. NEXT i%
  2716.  
  2717. '──────────────────────────────────────────────────────────────────────────
  2718. ' Restore default segment to BASIC's segment.
  2719. '──────────────────────────────────────────────────────────────────────────
  2720. DEF SEG
  2721.  
  2722. END SUB
  2723.  
  2724. FUNCTION SubMenu% (choice$(), currentMenu%, numOfChoices%, justify$, leftColumn, rightColumn, row%, marker$, fg%, bg%, hfg%, hbg%, qfg%, qbg%)
  2725.  
  2726. '┌───────────────────────────────────────────────────────────────────────┐
  2727. '│  This function is a special version of MakeMenu% and is used only by  │
  2728. '│  the MultiMenu routine.  It is not intended to be called by itself.   │
  2729. '│  See the MakeMenu% function if you need a single menu, or want to     │
  2730. '│  know more about the parameters of this function.                     │
  2731. '└───────────────────────────────────────────────────────────────────────┘
  2732.  
  2733. '─────────────────────────────────────────────────────────────────────────
  2734. ' Set local variables - extended scan codes for keypad keys
  2735. '─────────────────────────────────────────────────────────────────────────
  2736. up$ = CHR$(0) + CHR$(72)
  2737. down$ = CHR$(0) + CHR$(80)
  2738. enter$ = CHR$(13)
  2739. home$ = CHR$(0) + CHR$(71)
  2740. end$ = CHR$(0) + CHR$(79)
  2741. pgUp$ = CHR$(0) + CHR$(73)
  2742. pgDn$ = CHR$(0) + CHR$(81)
  2743. leftArrow$ = CHR$(0) + CHR$(75)
  2744. rightArrow$ = CHR$(0) + CHR$(77)
  2745.  
  2746. '─────────────────────────────────────────────────────────────────────────
  2747. ' Define the error tone string to use with PLAY
  2748. '─────────────────────────────────────────────────────────────────────────
  2749. errorTone$ = "MB T120 L50 O3 AF"
  2750.  
  2751. '─────────────────────────────────────────────────────────────────────────
  2752. ' Set type of justification to uppercase
  2753. '─────────────────────────────────────────────────────────────────────────
  2754. justify$ = UCASE$(justify$)
  2755. wdth% = (rightColumn - leftColumn - 1)
  2756.  
  2757. '─────────────────────────────────────────────────────────────────────────
  2758. ' Check for out-of-bounds parameters.  If any are out of range,
  2759. ' quit the function
  2760. '─────────────────────────────────────────────────────────────────────────
  2761. IF justify$ <> "C" AND justify$ <> "L" AND justify$ <> "R" THEN EXIT FUNCTION
  2762. IF leftColumn < 1 OR rightColumn > 80 THEN EXIT FUNCTION
  2763. IF row% < 1 OR row% > 24 THEN EXIT FUNCTION
  2764.  
  2765. '─────────────────────────────────────────────────────────────────────────
  2766. ' Calculate the array of character identifiers
  2767. '─────────────────────────────────────────────────────────────────────────
  2768. REDIM charID(numOfChoices%) AS STRING * 1
  2769. FOR x% = 1 TO numOfChoices%
  2770.     FOR y% = 1 TO LEN(choice$(currentMenu%, x%))
  2771.         IF MID$(choice$(currentMenu%, x%), y%, 1) = marker$ THEN
  2772.             charID(x%) = UCASE$(MID$(choice$(currentMenu%, x%), y% + 1, 1))
  2773.             EXIT FOR
  2774.         END IF
  2775.     NEXT y%
  2776. NEXT x%
  2777.  
  2778. '─────────────────────────────────────────────────────────────────────────
  2779. ' Calculate length of longest menu choice and store value in ChoiceLen%
  2780. '─────────────────────────────────────────────────────────────────────────
  2781. choiceLen% = 0
  2782. FOR x% = 1 TO numOfChoices%
  2783.     IF LEN(choice$(currentMenu%, x%)) > choiceLen% THEN
  2784.         choiceLen% = LEN(choice$(currentMenu%, x%))
  2785.     END IF
  2786. NEXT x%
  2787. choiceLen% = choiceLen% - 1
  2788.  
  2789. '─────────────────────────────────────────────────────────────────────────
  2790. ' Determine left-most column to display highlight bar on
  2791. '─────────────────────────────────────────────────────────────────────────
  2792. col = (((rightColumn - leftColumn - 1) - choiceLen%) / 2) + leftColumn
  2793.  
  2794. '─────────────────────────────────────────────────────────────────────────
  2795. ' Print menu choices to screen based on the type of Justification
  2796. ' selected (Center, Left, Right).
  2797. '─────────────────────────────────────────────────────────────────────────
  2798. COLOR fg%, bg%
  2799. SELECT CASE justify$
  2800.     CASE "C"
  2801.         FOR x% = 1 TO numOfChoices%
  2802.             xCol% = ((wdth% - (LEN(choice$(currentMenu%, x%))) - 1) \ 2 + leftColumn) + 1
  2803.             LOCATE (row% - 1) + x%, leftColumn - 1, 0
  2804.             PRINT SPACE$(choiceLen% + 2);
  2805.             LOCATE (row% - 1) + x%, xCol%, 0
  2806.             DisplayEntry choice$(currentMenu%, x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
  2807.         NEXT x%
  2808.     CASE "R"
  2809.         FOR x% = 1 TO numOfChoices%
  2810.             LOCATE (row% - 1) + x%, leftColumn - 1, 0
  2811.             PRINT SPACE$(choiceLen% + 2);
  2812.             LOCATE (row% - 1) + x%, (rightColumn - LEN(choice$(currentMenu%, x%)))
  2813.             DisplayEntry choice$(currentMenu%, x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
  2814.         NEXT x%
  2815.     CASE "L"
  2816.         FOR x% = 1 TO numOfChoices%
  2817.             LOCATE (row% - 1) + x%, leftColumn - 1, 0
  2818.             PRINT SPACE$(choiceLen% + 2);
  2819.             LOCATE (row% - 1) + x%, leftColumn, 0
  2820.             DisplayEntry choice$(currentMenu%, x%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
  2821.         NEXT x%
  2822. END SELECT
  2823.  
  2824. '─────────────────────────────────────────────────────────────────────────
  2825. ' Highlight the first entry in the list.  Must take into account the
  2826. ' justification type.
  2827. '─────────────────────────────────────────────────────────────────────────
  2828. currentLocation% = 1
  2829. COLOR hfg%, hbg%
  2830. LOCATE row%, leftColumn - 1: PRINT SPACE$(choiceLen% + 2);
  2831. SELECT CASE justify$
  2832.     CASE "C"
  2833.         xCol% = ((wdth% - (LEN(choice$(currentMenu%, currentLocation%))) - 1) \ 2 + leftColumn) + 1
  2834.         LOCATE (row% - 1 + currentLocation%), xCol%, 0
  2835.         DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
  2836.     CASE "R"
  2837.         LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentMenu%, currentLocation%)))
  2838.         DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
  2839.     CASE "L"
  2840.         LOCATE (row% - 1) + currentLocation%, leftColumn
  2841.         DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
  2842. END SELECT
  2843.  
  2844. '─────────────────────────────────────────────────────────────────────────
  2845. ' Read keystrokes and change the highlighted entry appropriately
  2846. '─────────────────────────────────────────────────────────────────────────
  2847. exitCode = FALSE
  2848. WHILE exitCode = FALSE
  2849.  
  2850.     '─────────────────────────────────────────────────────────────────────
  2851.     ' Read keystrokes
  2852.     '─────────────────────────────────────────────────────────────────────
  2853.     key$ = ""
  2854.     WHILE key$ = ""
  2855.         LET key$ = UCASE$(INKEY$)
  2856.     WEND
  2857.   
  2858.     SELECT CASE key$
  2859.  
  2860.         CASE up$, down$, home$, end$, pgUp$, pgDn$   '=== Legal movement
  2861.  
  2862.             '─────────────────────────────────────────────────────────────
  2863.             ' Restore old highlighted choice to normal colors
  2864.             '─────────────────────────────────────────────────────────────
  2865.             COLOR fg%, bg%
  2866.             LOCATE (row% - 1) + currentLocation%, leftColumn - 1: PRINT SPACE$(choiceLen% + 2);
  2867.             SELECT CASE justify$
  2868.                 CASE "C"
  2869.                     xCol% = ((wdth% - (LEN(choice$(currentMenu%, currentLocation%))) - 1) \ 2 + leftColumn) + 1
  2870.                     LOCATE (row% - 1 + currentLocation%), xCol%, 0
  2871.                     DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
  2872.                 CASE "R"
  2873.                     LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentMenu%, currentLocation%)))
  2874.                     DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
  2875.                 CASE "L"
  2876.                     LOCATE (row% - 1) + currentLocation%, leftColumn, 0
  2877.                     DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
  2878.             END SELECT
  2879.  
  2880.         CASE leftArrow$
  2881.  
  2882.             SubMenu% = LEFTARROWCODE
  2883.             EXIT FUNCTION
  2884.  
  2885.         CASE rightArrow$
  2886.  
  2887.             SubMenu% = RIGHTARROWCODE
  2888.             EXIT FUNCTION
  2889.  
  2890.         CASE CHR$(32) TO CHR$(127)  'If valid KEY code, then restore old entry
  2891.  
  2892.             FOR x% = 1 TO numOfChoices%
  2893.                 IF key$ = charID(x%) THEN
  2894.                     COLOR fg%, bg%
  2895.                     LOCATE (row% - 1) + currentLocation%, leftColumn - 1: PRINT SPACE$(choiceLen% + 2);
  2896.                     SELECT CASE justify$
  2897.                         CASE "C"
  2898.                             xCol% = ((wdth% - (LEN(choice$(currentMenu%, currentLocation%))) - 1) \ 2 + leftColumn) + 1
  2899.                             LOCATE (row% - 1 + currentLocation%), xCol%, 0
  2900.                             DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
  2901.                             EXIT FOR
  2902.                         CASE "R"
  2903.                             LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentMenu%, currentLocation%)))
  2904.                             DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
  2905.                             EXIT FOR
  2906.                         CASE "L"
  2907.                             LOCATE (row% - 1) + currentLocation%, leftColumn, 0
  2908.                             DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 1
  2909.                             EXIT FOR
  2910.                     END SELECT
  2911.                 END IF
  2912.             NEXT x%
  2913.  
  2914.         CASE CHR$(27)     ' The ESC key
  2915.  
  2916.             SubMenu% = 27
  2917.             EXIT FUNCTION
  2918.       
  2919.         CASE ELSE
  2920.  
  2921.             'Nuthin!
  2922.  
  2923.     END SELECT
  2924.  
  2925.     '─────────────────────────────────────────────────────────────────────
  2926.     ' Update our highlight bar's location based on which key was hit
  2927.     '─────────────────────────────────────────────────────────────────────
  2928.     SELECT CASE key$
  2929.  
  2930.         CASE up$
  2931.  
  2932.             '─────────────────────────────────────────────────────────────
  2933.             ' Set new currentLocation%
  2934.             '─────────────────────────────────────────────────────────────
  2935.             IF currentLocation% = 1 THEN
  2936.                 currentLocation% = numOfChoices%
  2937.             ELSE
  2938.                 currentLocation% = currentLocation% - 1
  2939.             END IF
  2940.           
  2941.         CASE down$
  2942.  
  2943.             '─────────────────────────────────────────────────────────────
  2944.             ' Set New currentLocation%
  2945.             '─────────────────────────────────────────────────────────────
  2946.             IF currentLocation% = numOfChoices% THEN
  2947.                 currentLocation% = 1
  2948.             ELSE
  2949.                 currentLocation% = currentLocation% + 1
  2950.             END IF
  2951.  
  2952.         CASE enter$
  2953.  
  2954.             '─────────────────────────────────────────────────────────────
  2955.             ' Set MakeMenu to highlighted selection and exit
  2956.             '─────────────────────────────────────────────────────────────
  2957.             SubMenu% = currentLocation%
  2958.  
  2959.             '─────────────────────────────────────────────────────────────
  2960.             ' Instead of using exitCode to beak out of this, we have to
  2961.             ' use EXIT FUNCTION, or it never quits.
  2962.             '─────────────────────────────────────────────────────────────
  2963.             EXIT FUNCTION
  2964.       
  2965.         CASE home$, pgUp$
  2966.  
  2967.             '─────────────────────────────────────────────────────────────
  2968.             ' Set New currentLocation%
  2969.             '─────────────────────────────────────────────────────────────
  2970.             currentLocation% = 1
  2971.  
  2972.         CASE end$, pgDn$
  2973.  
  2974.             '─────────────────────────────────────────────────────────────
  2975.             ' Set New currentLocation%
  2976.             '─────────────────────────────────────────────────────────────
  2977.             currentLocation% = numOfChoices%
  2978.  
  2979.         CASE CHR$(32) TO CHR$(127)
  2980.  
  2981.             '─────────────────────────────────────────────────────────────
  2982.             ' Check for "Quick Access" codes
  2983.             '─────────────────────────────────────────────────────────────
  2984.             validEntry% = FALSE
  2985.             FOR x% = 1 TO numOfChoices%
  2986.                 IF key$ = charID(x%) THEN
  2987.                     SubMenu% = x%
  2988.                     currentLocation% = x%
  2989.                     validEntry% = TRUE
  2990.                 END IF
  2991.             NEXT x%
  2992.  
  2993.             IF validEntry% = FALSE THEN
  2994.                 PLAY errorTone$
  2995.             END IF
  2996.  
  2997.         CASE ELSE
  2998.  
  2999.             '─────────────────────────────────────────────────────────────
  3000.             ' Play Error Tone - change this around if your don't like it
  3001.             '─────────────────────────────────────────────────────────────
  3002.             PLAY errorTone$
  3003.  
  3004.     END SELECT
  3005.  
  3006.     '─────────────────────────────────────────────────────────────────────
  3007.     ' Highlight the entry indicated by CurrentLocation%
  3008.     '─────────────────────────────────────────────────────────────────────
  3009.     SELECT CASE key$
  3010.       
  3011.         CASE up$, down$, home$, end$, pgUp$, pgDn$
  3012.  
  3013.             '─────────────────────────────────────────────────────────────
  3014.             ' Highlight new choice
  3015.             '─────────────────────────────────────────────────────────────
  3016.             COLOR hfg%, hbg%
  3017.             LOCATE (row% - 1) + currentLocation%, leftColumn - 1: PRINT SPACE$(choiceLen% + 2);
  3018.             SELECT CASE justify$
  3019.                 CASE "C"
  3020.                     xCol% = ((wdth% - (LEN(choice$(currentMenu%, currentLocation%))) - 1) \ 2 + leftColumn) + 1
  3021.                     LOCATE (row% - 1 + currentLocation%), xCol%, 0
  3022.                     DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
  3023.                 CASE "R"
  3024.                     LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentMenu%, currentLocation%)))
  3025.                     DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
  3026.                 CASE "L"
  3027.                     LOCATE (row% - 1) + currentLocation%, leftColumn, 0
  3028.                     DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
  3029.             END SELECT
  3030.  
  3031.         CASE CHR$(32) TO CHR$(127)
  3032.  
  3033.             FOR x% = 1 TO numOfChoices%
  3034.                 IF key$ = charID(x%) THEN
  3035.  
  3036.                     '─────────────────────────────────────────────────────
  3037.                     ' Highlight new choice
  3038.                     '─────────────────────────────────────────────────────
  3039.                     COLOR hfg%, hbg%
  3040.                     LOCATE (row% - 1) + currentLocation%, leftColumn - 1: PRINT SPACE$(choiceLen% + 2);
  3041.                     SELECT CASE justify$
  3042.                         CASE "C"
  3043.                             xCol% = ((wdth% - (LEN(choice$(currentMenu%, currentLocation%))) - 1) \ 2 + leftColumn) + 1
  3044.                             LOCATE (row% - 1 + currentLocation%), xCol%, 0
  3045.                             DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
  3046.                             EXIT FUNCTION
  3047.                         CASE "R"
  3048.                             LOCATE (row% - 1) + currentLocation%, (rightColumn - LEN(choice$(currentMenu%, currentLocation%)))
  3049.                             DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
  3050.                             EXIT FUNCTION
  3051.                         CASE "L"
  3052.                             LOCATE (row% - 1) + currentLocation%, leftColumn, 0
  3053.                             DisplayEntry choice$(currentMenu%, currentLocation%), qfg%, qbg%, hfg%, hbg%, fg%, bg%, marker$, 2
  3054.                             EXIT FUNCTION
  3055.                     END SELECT
  3056.                 END IF
  3057.             NEXT x%
  3058.       
  3059.         CASE ELSE
  3060.  
  3061.             'Nuthin!
  3062.  
  3063.     END SELECT
  3064.  
  3065. WEND
  3066. END FUNCTION
  3067.  
  3068. SUB Wipe (top%, bottom%, lft%, rght%, back%)
  3069.  
  3070. '┌────────────────────────────────────────────────────────────────────────┐
  3071. '│  This routine clears off a selected portion of the screen.  Note that  │
  3072. '│  the area cleared by this routine is always INSIDE the box defined by  │
  3073. '│  coordinates passed in.  This allows you to use the same values used   │
  3074. '│  for the window being WIPEd, without having to adjust them by one to   │
  3075. '│  avoid erasing your window border.                                     │
  3076. '│  The passed parameters are:                                            │
  3077. '│                                                                        │
  3078. '│      top% - The top-most row to clear.  Allowable range is 1 to 25.    │
  3079. '│      bottom% - The bottom-most row to clear.  Allowable range is       │
  3080. '│                1 to 25.                                                │
  3081. '│      lft% - The left-most column to clear.  Allowable range is 1 to    │
  3082. '│             80.                                                        │
  3083. '│      rght% - The right-most column to clear.  Allowable range is       │
  3084. '│              1 to 80.                                                  │
  3085. '│      back% - The background color to clear with.  Allowable range is   │
  3086. '│              0 to 7.                                                   │
  3087. '└────────────────────────────────────────────────────────────────────────┘
  3088.  
  3089. '─────────────────────────────────────────────────────────────────────────
  3090. ' Change to the passed background color
  3091. '─────────────────────────────────────────────────────────────────────────
  3092. COLOR , back%
  3093.  
  3094. '─────────────────────────────────────────────────────────────────────────
  3095. ' Clear the selected portion of the screen by overwriting with spaces
  3096. '─────────────────────────────────────────────────────────────────────────
  3097. FOR x% = top% + 1 TO bottom% - 1
  3098.     LOCATE x%, lft% + 1, 0
  3099.     PRINT SPACE$(rght% - lft% - 1);
  3100. NEXT x%
  3101.  
  3102. END SUB
  3103.  
  3104.